xmobar-0.46/0000755000000000000000000000000007346545000011124 5ustar0000000000000000xmobar-0.46/app/0000755000000000000000000000000007346545000011704 5ustar0000000000000000xmobar-0.46/app/Main.hs0000644000000000000000000000100307346545000013116 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Xmobar.Main -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz -- Stability : unstable -- Portability : unportable -- -- The main module of Xmobar, a text based status bar -- ----------------------------------------------------------------------------- module Main (main) where import Xmobar main :: IO () main = xmobarMain xmobar-0.46/bench/0000755000000000000000000000000007346545000012203 5ustar0000000000000000xmobar-0.46/bench/main.hs0000644000000000000000000000220107346545000013456 0ustar0000000000000000module Main (main) where import Data.IORef (newIORef) import Data.Time import Gauge import Xmobar import Xmobar.Plugins.Monitors.Cpu main :: IO () main = do defaultMain =<< sequence [cpuBench, dateBench] mkCpuArgs :: IO CpuArguments mkCpuArgs = getArguments ["-L", "3", "-H", "50", "--normal", "green", "--high", "red", "-t", "Cpu: %"] cpuBench :: IO Benchmark cpuBench = do cpuArgs <- mkCpuArgs return $ bgroup "Cpu Benchmarks" [ bench "CPU normal args" $ nfIO (runCpu cpuArgs) ] dateBench :: IO Benchmark dateBench = do let format = "D: %B %d %A W%V" zone <- getCurrentTimeZone zone' <- newIORef =<< getCurrentTimeZone return $ bgroup "Date Benchmarks" [ bench "Date" $ nfIO (date zone' format) , bench "DateZonedTime" $ nfIO (dateZonedTime format) , bench "DateWithTimeZone" $ nfIO (dateWithTimeZone zone format) ] dateZonedTime :: String -> IO String dateZonedTime format = fmap (formatTime defaultTimeLocale format) getZonedTime dateWithTimeZone :: TimeZone -> String -> IO String dateWithTimeZone zone format = fmap (formatTime defaultTimeLocale format . utcToZonedTime zone) getCurrentTime xmobar-0.46/changelog.md0000644000000000000000000010375107346545000013404 0ustar0000000000000000## Version 0.46 (January, 2023) - New bar position specifiers TopHM, BottomHM. - New configuration option, `dpi`, to set the font scaling factor. - Fixes and extensions for section aligment behaviour (#650, #655). - Fix: honour fc/bg specs for icons (#663). ## Version 0.45 (October, 2022) - New cairo/pango font drawing backend, substituting the direct X11/Xft one. ## Version 0.44.2 (August, 2022) - Documentation improvements. - Missing doc files and xmobar.el added to distribution. ## Version 0.44.1 (July, 2022) Repository moved to Codeberg. No code changes. ## Version 0.44 (July, 2022) _Breaking changes_ - Building with UTF-8 support is now mandatory (the with_utf8 flag is gone). _Bug fixes_ - Fix for -W "0" monitor spec in logarithmic bars. ## Version 0.43 (May, 2022) _New features_ - New monitor `Load` providing load averages (stolen from Finn Lawler, with FreeBSD support thanks to Michał Zielonka). - New argument `scale` for `Memory` monitor to scale size units. - New dbus signal: `SetAlpha` (see issue #499). - `CpuFreq`: new template parameters `max`, `min` and `avg`. _Bug fixes_ - MultiCoreTemp: allow temperature directory names with more than one digit. - Batt (linux): correct computation of power consumption based on actual voltage (Patrick Günther). ## Version 0.42 (March, 2022) _New features_ - New text mode (thanks to Pavel Kagulin, see issue #601), with output formats compatible with color terminals and pango. - New text mode with format following swaybar-protocol, supporting colors, faces, boxes and actions. _Bug fixes_ - Fix for bottom placement (#608) - Fix for memory leak during X drawing (#609) ## Version 0.41 (January, 2022) _New features_ - Disk monitors for FreeBSD (Michał Zielonka). - Improvements to signal handling when using xmobar as a library (John Soo). ## Version 0.40 (November, 2021) _New features_ - New plugin: `QueueReader` (Guy Gastineau). - Greatly improved FreeBSD support: Mem, Network and Swap monitors fixes, and CI build for FreeBSD (Michał Zielonka). - New template markup: ``(tulthix) ## Version 0.39 (August, 2021) _New features_ - New constructors for only controlling bar height: TopH and BottomH for Top and Bottom respectively - New monitor: k10temp (Sam Kirby) - Better handling of command line arguments for Haskell-based configuration keys (see #553 and #554) - New monitor: Kraken (Amid Saeid) _Bug fixes_ - NotmuchMail usable in text configurations (#547) - Fix for off-by-one in padding (#560) - Fixes for Kbd (#561) ## Version 0.38 (May, 2021) _Bug fixes_ - Fix off-by-one in strut calculation for `Static` position which reserved space for the panel than necessary and caused issues in some multi-head setups (fixes #530). - Revert the double-UTF-8 encoding workarounds of 0.36 (#482), as they're no longer necessary with xmonad-contrib master, and aren't needed with any released version of xmonad-contrib either. - Fix slow reactions to SIGUSR1/2 signals (reposition, change screen). ## Version 0.37 (November, 2020) _New features_ - New command line option `--add-font` (Ivan Brennan) - New monitor `MPDX` that extends `MPD` with the ability of having a custom alias. Useful for connecting with multiple servers. - New plugin `NotmuchMail` to monitor mail indexed by `notmuch`. _Bug fixes_ - Fix date plugin not picking up DST and timezone changes (refresh timezone once a minute to preserve the optimized performace of 0.34). ## Version 0.36 (August, 2020) _New features_ - Monitor progress bars: a value of 0 for `-W` denotes an index in the `-f` string, similar to icon patterns but using characters. - New tag `` to add borders around text (Unoqwy). - `fc` color background now accepts an offset (Unoqwy). _Bug fixes_ - Documentation fixes (Tomáš Janoušek) - Don't get confused by empty configuration dirs (fixes #412) - Xft rendering: Avoid encoding to UTF8 on all scenarios. This causes issue to StdinReader monitor when the handle wasn't binary. ## Version 0.35.1 (June, 2020) - Dropped support for GHC < 8.4 (see issue #461) ## Version 0.35 (June, 2020) _New features_ - `MultiCoreTemp` now works with Ryzen processors. New option `--hwmon-path` for better performance. - CPU Monitor optimizations. - Version bumps for some dependencies, including timezone-olson. ## Version 0.34 (June, 2020) _New features_ - New plugin `HandleReader` for reading data from a Haskell `Handle`. This is useful if you are running xmobar from within a Haskell program. - Build with ghc 8.10 allowed. - Optimize date plugin by avoiding calling getTimeZone for each of the time the date has to be updated. Instead, it's computed once at the start and re-used for each invocation. - Optimize Weather and UVMeter plugin by using global Manager instead of creating for each http request when useManager is explicitly configured as False. ## Version 0.33 (February, 2020) _New features_ - New template parameter `` for the `Weather` plugin, potentially displaying specific weather conditions that are occurring near the station (thanks to *slotThe*). - New option `--weathers`, for `Weather` to display a default string in case the `weather` field is not reported (thanks to *slotThe*). - New template parameter `` for the `Volume` plugin, combining the effects of `` and ``. This will show the volume (possibly prefixed by `onString` or a percentage-based string) if and only if the volume is not muted. Otherwise it will show the `offString` (thanks to *slotThe*). - `Battery` and `BatteryN` now support FreeBSD (thanks to Dhananjay Balan). - New option `--useManager` for `Weather` and `UVMeter` to decide whether to use one single manager per monitor for managing network connections or create a new one every time a connection is made. - New more efficient time coalescing strategy for monitor updates, available with the threaded runtime: use the `with_threaded` flag to enable it (see #410; thanks to Tomáš Janoušek). - `Wireless` supports current nl80211 API on Linux now, old Wext ioctls still available as compile-time option (thanks to Paul Fertser). ## Version 0.32 (December, 2019) _New features_ - New options `--host` and `--port` for `MPD` monitor. - New plugin `MailX` extending `Mail` with colors and prefix/suffix. - New options `--lows`, `--mediums`, and `--highs` for `Battery` to display an additional string depending on battery level (thanks to *slotThe*). - New options `-L` and `-H` for `Volume` to set low and high volume levels, as well as `-l`, `-m`, and `-h` to display an additional string depending on current volume level (thanks to *slotThe*). - New option `-P` in `Battery` to add a `%` symbol to ``. - New option `--devices` in `DynNetwork` to select what interfaces to monitor (thanks to *vindex10*). - DateZone plugin now also checks TZDIR (thanks to Emmanuel Rosa). _Bug fixes_ - `Kbd` plugin: ignore "terminate" layout token (thanks to Greg Steuck). - Fixed compilation with GHC 8.8.x (thanks to Vanessa McHale). - Avoid creating `~/.xmobar` ([issue #405]). [issue #405]: https://codeberg.org/xmobar/xmobar/issues/405 ## Version 0.31 (October, 2019) _New features_ - New option `--contiguous-icons` for `MultiCpu` to draw icons without padding (see [issue #388]). - New version of libmpd (0.9.0.10), thanks to John Tyree [issue #388]: https://codeberg.org/xmobar/xmobar/issues/388 ## Version 0.30 (August, 2019) _New features_ - New monitor `MultiCoreTemp`, thanks to Felix Springer. - `DiskIO`: Additional template variables for absolute number of bytes rather than speeds (see [issue #390]). - `WeatherX`: An extension to the `Weather` monitor allowing the spefication of custom strings or icons for sky conditions. - The battery monitors accept the new arguments `-a` and `-A` to specify a system command executed if battery left goes beyond a given threshold. [issue #390]: https://codeberg.org/xmobar/xmobar/issues/390 ## Version 0.29.5 (March, 2019) _Bug fixes_ - Honour command line flags when starting xmobar without any configuration file (issue #375). - `Alsa` plugin: restart `alsactl` if it quits, e.g. because of a sleep/awake cycle (issue #376). - `Weather` using the new HTTPS URL, which requires http-conduit as a dependency (issue #378). - `MarqueePipeReader` exported at the API level (issue #381). ## Version 0.29.4 (December, 2018) Upgrade to alsa-mixer 0.3.0. See issues #372 and #373. ## Version 0.29.3 (December, 2018) _Bug fixes_ - Upper bound for alsa_mixer (see [issue #372]) [issue #372]: https://codeberg.org/xmobar/xmobar/issues/372 ## Version 0.29.2 (December, 2018) _Bug fixes_ - Work as usual with .xmobarrc (see [issue #371]). [issue #371]: https://codeberg.org/xmobar/xmobar/issues/371 ## Version 0.29.1 (December, 2018) _Bug fixes_ - Honour command line flags (fixes [issue #370]). - Expose Cmd and CmdX in Xmobar interface. [issue #370]: https://codeberg.org/xmobar/xmobar/issues/370 ## Version 0.29 (December, 2018) _New features_ - New `Alsa` monitor for volume display that doesn't use polling, by Daniel Schüssler. - `ThermalZone` retries reading missing files, thanks to Reed Koser. - `TopProc` ignores kernel threads (see also [issue #369]). - `Wireless` simple autodetection of wirless interface name (if set to ""). - Experimental support for using xmobar as a library, so that configurations are in fact Haskell programs a la Xmonad (beta stage, with help from Pavan Rikhi). Traditional config files are still (and will continue to be) supported. _Bug fixes_ - Correctly parsing configuration options `mwClass` and `wmName`. [issue #369]: https://codeberg.org/xmobar/xmobar/issues/369 ## Version 0.28.1 (October, 2018) Dependencies updated to work with GHC 8.6, avoiding [issue #354]. [issue #354]: https://codeberg.org/xmobar/xmobar/issues/354 ## Version 0.28 (August, 2018) _New features_ - New `ComX`, which runs a command with custom exit error message. _Bug fixes_ - hinotify version upgraded ([issue #356]) [issue #356]: https://codeberg.org/xmobar/xmobar/issues/356 ## Version 0.27 (July, 2018) _New features_ - Dropped support for GHC 7.x. See [issue #352]. - New configuration option, `textOffsets` to specify separate vertical offsets for each of the fonts in `additionalFonts`. See [issue #311]. _Bug fixes_ - Use the maximum width options `-T` and `-E` correctly when a monitor subtemplate contains font and color tags. [issue #311]: https://codeberg.org/xmobar/xmobar/issues/311 [issue #352]: https://codeberg.org/xmobar/xmobar/issues/352 ## Version 0.26 (April, 2018) _New features_ - New options to specify the ellipsis string for fields (`-e`) and total width (`-E`), thanks to Olivier Schneider. - `MultiCpu`: New option to specify fallback icon paths (`--fallback-icon-pattern`), thanks to Reed Koser. _Bug fixes_ - `CpuFreq` monitors honours `-d` (number of digits) if no suffix is given (cf. [issue #335]). - Race condition in network monitor fixed ([issue #347]). - Limiting dbus supported version (see [issue #346]). [issue #335]: https://codeberg.org/xmobar/xmobar/issues/335 [issue #346]: https://codeberg.org/xmobar/xmobar/issues/346 [issue #347]: https://codeberg.org/xmobar/xmobar/issues/347 ## Version 0.25 (February, 2018) _New features_ - The X11 properties `WM_NAME` and `WM_CLASS` for xmobar windows can be setup in either the configuration file (`wmName` and `wmClass`) or using the new flags `-n` adn `-w` (see [issue #323]). - New flag `with_weather`, to build sans `Weather` monitor. _Bug fixes_ - Honouring -x in MPris monitor ([issue #325]) [issue #323]: https://codeberg.org/xmobar/xmobar/issues/323 [issue #325]: https://codeberg.org/xmobar/xmobar/issues/325 ## Version 0.24.5 (May, 2017) _Bug fixes_ - Fix for vertical bars ([issue #303]) [issue #303]: https://codeberg.org/xmobar/xmobar/issues/303 ## Version 0.24.4 (April, 2017) _Infrastructure_ - Whe have now an active [Travis CI setup]. [Travis CI setup]: https://travis-ci.org/jaor/xmobar _Bug fixes_ - Reduce wakeups rate via rtsopts V0 (with new flag with_rtsopts to disable it) (see [issue #89]). - Fix Net monitor for lage uptimes and bytecounts (Tomas Janoušek). - Fix MultiCpu monitor for large uptimes (Zev Weiss). - Fix compilation when XMP is disabled (Sergi Trofimovich). - Better fatal error messages (Michael Bishop). - More paths to read from in CoreTemp (see [issue #291]). [issue #291]: https://codeberg.org/xmobar/xmobar/issues/291 ## Version 0.24.3 (Sep 5, 2016) _Bug fixes_ - Battery monitor: fixes for cases where status is not consistently reported by the kernel (see [issue #271]). [issue #271]: https://codeberg.org/xmobar/xmobar/issues/271 ## Version 0.24.2 (Aug 8, 2016) _Bug fixes_ - New Weather plugin URL (see [issue #270]). [issue #270]: https://codeberg.org/xmobar/xmobar/issues/270 ## Version 0.24.1 (Jul 28, 2016) _Bug fixes_ - Restoring compatibility with GHC 7.6, (see [issue #269]). [issue #269]: https://codeberg.org/xmobar/xmobar/issues/269 ## Version 0.24 (Jul 26, 2016) _New features_ - Use the new compilation flag `with_conduit` to compile an implemetation of the `Weather` plugin that will work behind proxies, by Dragos Boca. - New command line argument (`-p`) to specify xmobar's position, by Valentin Shirokov. - Wind speed in Km/h and m/s for the `Weather` plugin, by Michael Knabe. - `UVMeter`, a new optional plugin showing UV data for Australian users, by Roman Joost. - New template parameter `` for the `MPD` plugin (by Bruno Heridet) - New monitor argument `-T` to specify the maximum total width of the monitor text. - New $VAR parameter syntax for using env vars in pipe monitors, by Will Song (see [issue #268]). _Bug fixes_ - The `Volume` plugin now supports capture devices (Antoine Eiche). - The `MPD` plugin will now automatically update on options changes (Ben Boeckel). - The `Battery` plugin does now a better job at tracking AC status and times (see [issue #231]). - `PipeReader` was polling too often (thanks to zlbruce). - The `MPris` monitor now honours field width and padding optons (-M, -w, etc.). - `Batt`: sensible thresholds for high/low power consumption (see [issue #265]). [issue #231]: https://codeberg.org/xmobar/xmobar/issues/225 [issue #265]: https://codeberg.org/xmobar/xmobar/issues/225 [issue #268]: https://codeberg.org/xmobar/xmobar/issues/268 ## Version 0.23.1 (Apr 14, 2015) _Bug fixes_ - Vertical alignment for icons, [issue #216] - Improvements to vertical text alignment, with many thanks to Jan Palus (see ongoing discussion in [issue #221]). - Better error handling in `Volume` monitor, [issue #215] - Compilation with ghc 7.8 and 7.10 (thanks to Edward Tjörnhammar, see [issue #225]). [issue #225]: https://codeberg.org/xmobar/xmobar/issues/225 [issue #221]: https://codeberg.org/xmobar/xmobar/issues/221 [issue #216]: https://codeberg.org/xmobar/xmobar/issues/216 [issue #215]: https://codeberg.org/xmobar/xmobar/issues/215 ## Version 0.23 (Mar 8, 2015) _New features_ - Xmobar can now use a (semi)transparent background: set it with the new configuration option `alpha` (thanks to Edward Z. Yang, see [issue #114]). - Multiple fonts available by means of the new configuration parameter `additionalFonts` and the template markers `...`, by Markus Scherer. - New variables in `Mem` monitor for available memory as reported by Linux 3.14 and newer, by Samuli Thomasson. - New configuration parameters `textOffset` and `iconOffset` (see discussion in [issue #171] and [issue #201]). - New template variable `flags` in `MPD` monitor, by Duncan Burke. [issue #171]: https://codeberg.org/xmobar/xmobar/issues/171 [issue #201]: https://codeberg.org/xmobar/xmobar/issues/201 [issue #114]: https://codeberg.org/xmobar/xmobar/issues/114 _Bug fixes_ - We honour the `-S` (show suffix) monitor flag in `CpuFreq`. - Better `Weather` parsing of wind direction, by Dino Morelli (see [pull #212]). [pull #212]: https://codeberg.org/xmobar/xmobar/pulls/212 ## Version 0.22.1 (Oct 11, 2014) _Bug fixes_ - Fix compilation in systems that don't need mtl newer than the one shipped with GHC. ## Version 0.22 (Oct 9, 2014) _New features_ - New `MarqueePipeReader` plugin by Reto Hablützel. - `Network` monitor has now adaptive units (`-S` is used now to switch them on), by Axel Angel. - `Weather` now offers `dewPointC` and `dewPointF` instead of `dewPoint`, and the new `windCardinal`, `windAzimuth`, `windMph` and `windKnots` variables, by Tony Morris. - Strings in the configuration file can now span multiple lines using Haskell-style multiline script, thanks to dunric - Icons can now be also xpm files (if xmobar is compiled with `with_xpm`), thanks to Alexander Shabalin. - New `borderWidth` option to set xmobar's boder width, thanks to Travis Staton. - Support for multiple Xft fonts, thanks to Phil Xiaojun Hu and Cedric staub (see [pull request #196]). - Icon patterns for several monitors, that allow you to specify a collection of icons to use for successive integer variable values, thanks to Alexander Shabalin (see [pull request #192] and the documentation for details). - Upgrade to libmpd 0.9. _Bug fixes_ - Much more efficient implementation of the `Locks` plugin, thanks to Anton Vorontsov (see [pull request #195]). - Not colorizing total disk size in `DiskU` ([issue #189]). - Avoiding zombies on click actions, thanks to Phil Xiaojun Hu ([issue #181]). [issue #181]: https://codeberg.org/xmobar/xmobar/issues/181 [issue #189]: https://codeberg.org/xmobar/xmobar/issues/189 [pull request #192]: https://codeberg.org/xmobar/xmobar/pulls/192 [pull request #195]: https://codeberg.org/xmobar/xmobar/pulls/195 [pull request #196]: https://codeberg.org/xmobar/xmobar/pulls/196 ## Version 0.21 (Jul 1, 2014) _New features_ - Vertical bar indicators using unicode available for most monitors, by Eric Mrak. - `CoreTemp`: support for linux 3.15, by Tomáš Janoušek. - New `CatInt` monitor, displaying integer values read from a file, by Nathaniel Wesley Filardo. - New `` tag for safer input parsing, also by Nathaniel. - New `UnsafeXMonadLog` monitor (by Eric Mrak) and their xproperty counterparts, `UnsafeXPropertyLog` and `UnsafeNamedXPropertyLog`. _Bug fixes_ - `Network` now reports status for ppp connections (see [issue #89]). - Fix for very long running `Cpu` monitors, by Robert J Macomber. [issue #89]: https://codeberg.org/xmobar/xmobar/issues/89 ## Version 0.20.1 (March 13, 2014) _New features_ - Back to picking by default the first available screen, with a new configuration option, `pickBroadest`, for choosing the broadest (see [issue #158]). [issue #158]: https://codeberg.org/xmobar/xmobar/issues/158 ## Version 0.20 (March 10, 2014) _New features_ - Mouse actions now support multiple buttons, by Marcin Mikołajczyk. - Non supported monitors are ignored in configuration files (see [issue #139]), by Adam Vogt. _Bug fixes_ - `Disk` monitor now ignores non-existent devices (Reto Hablützel). - `Weather` is now non-blocking and doesn't use curl (Ben Boeckel). - Fix for `Memory` monitor in 3.14 kernels (Ben Boeckel). - Fix for infinite loops in `AutoMPD` ([issue #76], [issue #111]). - More robust AC readings in `BatteryP`. - Fix for `Top` monitor's readings for processes whose name contains blanks. - Fixes for geometry computation on multihead (Dmitry Malikov). - Fixes for missing XDG configuration (Thiago Negri and James McCoy, see [issue #133]). - Compatibility with latest `directory` (1.2.0.2). [issue #76]: https://codeberg.org/xmobar/xmobar/issues/76 [issue #111]: https://codeberg.org/xmobar/xmobar/issues/111 [issue #133]: https://codeberg.org/xmobar/xmobar/issues/133 [issue #139]: https://codeberg.org/xmobar/xmobar/issues/133 ## Version 0.19 (October 27, 2013) As of this release, the old bug tracker at Google code is deprecated. Please use [codeberg's tracker] for new bugs. _New features_ - New monitor `BatteryN`, a variant of `BatteryP` that lets you specify the name of the monitor in the template. - Support for configuration file living in `XDG_CONFIG_HOME` (see [codeberg #99]). - `Com` uses safer `runInteractiveProcess` instead of spawning a shell (David McLean). If you're using shell expansion in your `Com` (e.g. "~/bin/script") here's a workaround: `Run Com "/bin/bash" ["-c", "~/bin/script"]` (cf. [codeberg #127]). - New plugin `UnsafeStdinReader` that allows actions from stdin. Now it's possible to have clickable workspaces! (Thiago Negri, see [codeberg #125]). - New monitor configuration option (`-x` or `--nastring`) that allows specifying what string to display when a monitor is not available (defaulting to "N/A"). Cf. [codeberg #119]. _Bug fixes_ - Using the width options `-w`, `-m` and `-M` in battery monitors watts display ([codeberg #118]). - Using the `-d` option in `CoreTemp` ([codeberg #115]) - Fix for systems not supporting PCRE regular expressions: we use now BCEs, so regex-compat should be enough everywhere (see [codeberg #117]). - Weather monitor: support for stations without name (Sergei Trofimovich, [issue #65]). [codeberg's tracker]: https://codeberg.org/xmobar/xmobar/issues [codeberg #99]: https://codeberg.org/xmobar/xmobar/issues/115 [codeberg #115]: https://codeberg.org/xmobar/xmobar/issues/115 [codeberg #117]: https://codeberg.org/xmobar/xmobar/issues/117 [codeberg #125]: https://codeberg.org/xmobar/xmobar/issues/125 [issue #65]: http://code.google.com/p/xmobar/issues/detail?id=65 [codeberg #118]: https://codeberg.org/xmobar/xmobar/issues/118 [codeberg #119]: https://codeberg.org/xmobar/xmobar/issues/119 [codeberg #127]: https://codeberg.org/xmobar/xmobar/issues/127 ## Version 0.18 (June 5, 2013) _New features_ - All extra argument monitors taking a string (e.g. `-O` for `BatteryP`) accept now template variables (see [codeberg #109] and [#110]). Thanks to Todd Lunter. - New battery monitor extra argument, `-i`, for the idle status. _Bug fixes_ - Safer standard input parsing, avoiding injections. [codeberg #109]: https://codeberg.org/xmobar/xmobar/issues/109 [#110]: https://codeberg.org/xmobar/xmobar/issues/110 ## Version 0.17 (May 5, 2013) _New features_ - Icons support: it's now possible to insert bitmaps in the template (Edward O'Callaghan, Alexander Polakov and Tomáš Janoušek). - Initial support for reacting to mouse clicks (Alexander Polakov). - New `TopP` and `BottomP` alignments, taking left and right paddings (thanks to Dmitry Malikov). - New `` field for memory monitor (Peter Simons). - New `allDesktops` and `overrideRedirect` configuration options, providing dock behaviour in tiling WMs (when set to True and False respectively). Cf. discussion at [codeberg #105]. - Experimental `-d` (start as a dock) option, may address [codeberg #67] in some window managers. _Bug fixes_ - Partial (as reports go) fix for [codeberg #77]. - Safer volume plugin (Dmitry Malikov). - Battery percentage capped at 100% (RJ Regenold). [codeberg #67]: https://codeberg.org/xmobar/xmobar/issues/67 [codeberg #77]: https://codeberg.org/xmobar/xmobar/issues/77 [codeberg #105]: https://codeberg.org/xmobar/xmobar/issues/105 ## 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 [codeberg #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 [codeberg #71]). _Known problems_ Some users have reported problems with xmobar compiled with GHC 7.6 in ArchLinux: see [codeberg #78] and pointers therein. Please, send reports of any problems or successes in that regard so that we can fix any remaining issues. Thanks! [codeberg #71]: https://codeberg.org/xmobar/xmobar/issues/71 [codeberg #73]: https://codeberg.org/xmobar/xmobar/issues/73 [codeberg #78]: https://codeberg.org/xmobar/xmobar/issues/78 ## Version 0.15 (June 4, 2012) _Incompatible changes_ - `Batt` monitor no longer uses `-c` to specify the charge file: it should figure things out by itself (cf. [issue 69]). _New features_ - New command line option, `-C`, that allows *adding* commands to those specified in the configuration file (Ben Boeckel). - Dependency on GHC's threaded runtime has been eliminated. - New MPRIS (versions 1 and 2) monitor, by Artem Tarasov. - New monitor option `-d` to specify the number of decimal places to display for float numbers. Defaults to 0. See [issue 58]. - New compilation option `--with_threaded`, to use GHC's threaded runtime to compile xmobar. Disabled by default (cf. discussion in [codeberg #36]). _Bug fixes_ - Stricter build dependencies versioning in cabal file. - [issue 56] vertical alignment of text improved. - [issue 64] display of `watts` in `Batt` monitor fixed. - [issue 69] miscellaneous battery reporting issues. - [issue 67] compilation in DragonFly. - DiskIO works also when device path in mtab are symbolic links to the real device file. - Wireless monitor honours padding settings for ESSID names. - CoreTemp monitor fixed for newer kernels ([codeberg #38]). [issue 56]: http://code.google.com/p/xmobar/issues/detail?id=56 [issue 58]: http://code.google.com/p/xmobar/issues/detail?id=58 [issue 64]: http://code.google.com/p/xmobar/issues/detail?id=64 [issue 67]: http://code.google.com/p/xmobar/issues/detail?id=67 [issue 69]: http://code.google.com/p/xmobar/issues/detail?id=69 [codeberg #36]: https://codeberg.org/xmobar/xmobar/issues/36 [codeberg #38]: https://codeberg.org/xmobar/xmobar/issues/38 ## Version 0.14 (Dec 10, 2011) _New features_ - New brightness monitor, courtesy of Martin Perner. - New DateZone plugin, for configurable timezone and localized datetimes, also by Martin. - New keyboard layout monitor (Kbd). Yes, by Martin. - Rewrite of the event handling ([issue 53], [issue 57]), you guessed it. - Cpu monitor now also reports `iowait` field ([issue 55]). - Battery monitor: the full charge file is now settable in the monitor arguments (olpc systems use `charge_full_design`; see [issue 62]). _Bug fixes_ - [issue 45] Fix for crashes with AC status changes in battery monitor. - [issue 48] The field of Wireless behaves like a percentage. - [issue 50]/[issue 61]: `MPD` monitor now works with libmpd 0.6. - [issue 60] Fixes for crashes on power resume for battery monitor. - Template sections without fields are now correctly displayed. - Catch errors when reading battery status (Ben Boeckel). - Compilation issues with ghc 7.x (Sergei Trofimovich). - Fixes for CoreTemp monitor in new kernels (Norbert Zeh). - Fix for pulseaudio problems in volume monitor (Martin Perner). - Fix for parsing errors when a `Run` entry ended in an array (Martin). - Fixed compilation in OpenBSD (Ivo van der Sangen). [issue 45]: http://code.google.com/p/xmobar/issues/detail?id=45 [issue 48]: http://code.google.com/p/xmobar/issues/detail?id=48 [issue 50]: http://code.google.com/p/xmobar/issues/detail?id=50 [issue 53]: http://code.google.com/p/xmobar/issues/detail?id=53 [issue 55]: http://code.google.com/p/xmobar/issues/detail?id=55 [issue 57]: http://code.google.com/p/xmobar/issues/detail?id=57 [issue 60]: http://code.google.com/p/xmobar/issues/detail?id=60 [issue 61]: http://code.google.com/p/xmobar/issues/detail?id=61 [issue 62]: http://code.google.com/p/xmobar/issues/detail?id=62 ## Version 0.13 (March 28, 2011) _New features_ - New `Volume` monitor displaying ALSA soundcards information, by Thomas Tuegel. - New `ThermalZone` plugin substituting `Thermal` and using linux's *sysfs* interface (you need this one if you're using a kernel version equal to or above 2.6.37). See [issue 44]. - xmobar app new has WM_CLASS, WM_NAME and _NET_WM_PID xprops ([issue 38]). _Incompatible changes_ - In the process of solving [issue 14], we've broken those configurations that rely on including alignment separators in the input fed to `StdinReader`. - The MPD plugin does not accept host and port options anymore: use the environment variables MPD_HOST and MPD_PORT instead. - The `Mail` plugin now takes a second parameter (a string) specifying its alias. As a side-effect, this solves [issue 30]. _Bug fixes_ - [issue 14] `StdinReader` and other plugins accepting external input don't get confused anymore when characters from `alignSep` appear in their input. - [issue 27] `BottomSize` placement now respects its width argument. - [issue 28] Compilation in Mac OS X fixed. - [issue 30] `Mail` plugin can be specified anywhere in commands list. - [issue 36] Battery monitor now supports non-standard locations of the `/sys/class/power_supply/AC/online` file. - [issue 40] Battery monitor now supports the new power_now, that replaces current_now in linux kernels for v. 2.36 and above. - [issue 42] More accurate net monitor rates. - DiskIO, Cpu and MultiCpu monitors are also more accurate now. - Text is now correctly centered vertically. - `FullBM` border spec fixed. [issue 14]: http://code.google.com/p/xmobar/issues/detail?id=14 [issue 27]: http://code.google.com/p/xmobar/issues/detail?id=27 [issue 28]: http://code.google.com/p/xmobar/issues/detail?id=28 [issue 30]: http://code.google.com/p/xmobar/issues/detail?id=30 [issue 36]: http://code.google.com/p/xmobar/issues/detail?id=36 [issue 38]: http://code.google.com/p/xmobar/issues/detail?id=38 [issue 40]: http://code.google.com/p/xmobar/issues/detail?id=40 [issue 42]: http://code.google.com/p/xmobar/issues/detail?id=42 [issue 44]: http://code.google.com/p/xmobar/issues/detail?id=44 ## Version 0.12 (Dec 24, 2010) xmobar has a new [maintainer], a new [website], a new [mailing list] and uses a new [source code repository]. Many thanks to Andrea Rossato, xmobar's author and maintainer so far, for creating xmobar in the first place, and for giving me the chance to become its maintainer. And a big thanks to Ben Boeckel, Petr Rockai and Norbert Zeh for their patches. [website]: http://projects.haskell.org/xmobar/ [mailing list]: http://projects.haskell.org/cgi-bin/mailman/listinfo/xmobar [source code repository]: https://codeberg.org/xmobar/xmobar [maintainer]: http://hacks-galore.org/jao/ _New features_ - Window borders: configuration options `border` and `borderColor` allow drawing borders around xmobar's window. - New monitor, `Uptime`, showing the system uptime. - New monitor argument (`-S`) to enable displaying the `%` symbol in percentages or other suffixes (e.g., units in Uptime and Network); the symbol is now never included by default. - New 'run once' commands, by specifying a 0 refresh rate in `Run Com` ([issue 26]). - MPD monitor: updated to libmpd 1.5. New fields `ppos` (playlist position) and `remaining` (remaining time). New configuration options to specify MPD's host, user name and password. - Battery monitor: new `watts` and `timeleft` fields (Petr Rockai), and specific arguments to control coloring and thresholds of the former. - MultiCPU monitor: new `auto*` fields that automatically detect all present CPUs (Ben Boeckel). - CpuFreq monitor uses just one decimal digit for GHz values (Petr Rockai). - Mail plugin expands paths starting with "~/" (Ben Boeckel). Ditto MBox. - Weather monitor now skips not retrieved fields, instead of displaying a long error message. - New compilation flag, `all_extensions`. - Documentation and website updates. _Bug fixes_ - [issue 23] Wireless monitor is now compatible with iwlib 29. - [issue 24] Swap monitor's used ratio display fixed. - [issue 25] Percentages only include `%` if requested using `-P`. - [issue 31] MPD monitor now respects `-W` argument. - Fixes in CPU frequency formatting, string alignment and colour boxes in monitors (Norbert Zeh). - TopMem and TopProc now use the `-L` and `-H` options correctly for memory template fields. - MBox skips non-existent mbox paths instead of hanging. [issue 23]: http://code.google.com/p/xmobar/issues/detail?id=23 [issue 24]: http://code.google.com/p/xmobar/issues/detail?id=24 [issue 25]: http://code.google.com/p/xmobar/issues/detail?id=25 [issue 26]: http://code.google.com/p/xmobar/issues/detail?id=26 [issue 31]: http://code.google.com/p/xmobar/issues/detail?id=31 xmobar-0.46/doc/0000755000000000000000000000000007346545000011671 5ustar0000000000000000xmobar-0.46/doc/compiling.org0000644000000000000000000001267707346545000014400 0ustar0000000000000000#+title: Compiling xmobar * Getting the source If you don't have =cabal-install= installed, you can get xmobar's source code in a variety of ways: - From [[http://hackage.haskell.org/package/xmobar/][Hackage]]. Just download the latest release from xmobar's hackage page. - From [[http://codeberg.org/xmobar/xmobar/][Codeberg]]. There are also tarballs available for every tagged release on [[https://codeberg.org/xmobar/xmobar/releases][Codeberg's releases page]] - From the bleeding edge repo. If you prefer to live dangerously, just get the latest and greatest (and buggiest, I guess) using git: #+begin_src shell git clone git://codeberg.org/xmobar/xmobar #+end_src * C library dependencies :PROPERTIES: :CUSTOM_ID: c-libraries :END: To build xmobar you will need the Xorg and Pango/Cairo C-libraries and headers installed in your system. In Debian and derivatives that's easily accomplished via #+begin_src shell apt-get install -y xorg-dev libxrandr-dev libpango1.0-dev #+end_src and, optionally, in order to be able to build all available extensions and plugins: #+begin_src shell apt-get install -y libasound2-dev libxpm-dev libmpd-dev #+end_src * Compilation using cabal If you have cabal installed, you can now use it from within xmobar's source tree: #+begin_src shell cabal install --flags="all_extensions" #+end_src * Compilation using stack There is also a =stack.yaml= file that will allow you to install the xmobar executable with #+begin_src shell stack install #+end_src See the =stack.yaml= file for the enabled extensions. You can also pass them to =stack= directly: #+begin_src shell stack install --flag xmobar:all_extensions #+end_src * Compilation flags :PROPERTIES: :CUSTOM_ID: optional-features :END: You can configure xmobar to include some optional plugins and features, which are not compiled by default. To that end, you need to add one or more flags to either the cabal install command or the configure setup step. Extensions need additional Haskell packages (listed below) that will be automatically downloaded and installed if you're using cabal install. Otherwise, you'll need to install them yourself. ** Optional features - =with_dbus= Enables support for DBUS by making xmobar to publish a service on the session bus. Requires the [[http://hackage.haskell.org/package/dbus][dbus]] package. - =with_threaded= Uses GHC's threaded runtime. Use this option if xmobar enters a high-CPU regime right after starting. - =with_xrender= Enables the main bar background alpha parameter. Requires the [[http://hackage.haskell.org/package/X11-xft/][X11-xft]] package. The Xrender extension is not compatible with 10-bit colour modes, i.e., setting ~DefaultDepth~ to 30 in your Xorg configuration. See discussion in [[https://codeberg.org/xmobar/xmobar/issues/651][issue 651]] for details. - =with_xpm= Support for xpm image file format. This will allow loading .xpm files in ==. Requires the [[http://cgit.freedesktop.org/xorg/lib/libXpm][libXpm]] C library. ** Optional plugins The following plugins and monitors are optional. You can enable them all at once using the flag ~all_extensions~, or one by one with the following flags: - =with_mpd= Enables support for the [[http://mpd.wikia.com/][MPD]] daemon. Requires the [[http://hackage.haskell.org/package/libmpd/][libmpd]] package. - =with_mpris= Enables support for MPRIS v1/v2 protocol used by the plugins of the same name. Requires the [[http://hackage.haskell.org/package/dbus][dbus]] and [[http://hackage.haskell.org/package/text][text]] packages. - =with_inotify= Support for inotify in modern Linux kernels. This option is needed for the ~MBox~ and ~Mail~ plugins to work. Requires the [[http://hackage.haskell.org/package/hinotify/][hinotify]] package. - =with_nl80211= Support for wireless cards on Linux via nl80211 (all upstream drivers). Enables the ~Wireless~ plugin. Requires [[http://hackage.haskell.org/package/netlink][netlink]] and [[http://hackage.haskell.org/package/cereal/][cereal]] packages. - =with_alsa= Support for ALSA sound cards. Enables the Volume plugin. Requires the [[http://hackage.haskell.org/package/alsa-mixer][alsa-mixer]] package. To install the latter, you'll need the [[http://packages.debian.org/stable/libasound2-dev][libasound]] C library and headers in your system (e.g., install =libasound2-dev= in Debian-based systems). - =with_datezone= Support for other timezones. Enables the DateZone plugin. Requires [[http://hackage.haskell.org/package/timezone-olson][timezone-olson]] and [[http://hackage.haskell.org/package/timezone-series][timezone-series]] package. - =with_weather= Support to display weather information. Enables Weather plugin. Finally, the following flags enable plugins not included by ~all_extensions~: - =with_uvmeter= Enables the ~UVMeter~ plugin. The plugin shows UV data for Australia. - =with_kraken= Enables the ~Kraken~ plugin. - =with_iwlib= Support for wireless cards via Wext ioctls (deprecated). Enables the ~Wireless~ plugin. You will need the [[http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html][iwlib]] C library and headers in your system (e.g., install =libiw-dev= in Debian-based systems or =wireless_tools= on Arch Linux). Conflicts with =with_nl80211=. xmobar-0.46/doc/plugins.org0000644000000000000000000016327507346545000014101 0ustar0000000000000000#+title: Plugins and monitors * System monitor plugins 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 may have default aliases, see the documentation of the monitor in question. There are two types of arguments: ones that all monitors share (the so called /default monitor arguments/) and arguments that are specific to a certain monitor. All Monitors accept a common set of arguments, described below in [[Default Monitor Arguments]]. Some monitors also 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. For example, the following [[=Battery Args RefreshRate=][Battery]] configuration first sets the global =template= and =Low= arguments and then specifies the battery-specific =off= option. #+begin_src haskell Run Battery [ "--template", "" , "--Low" , "15" -- battery specific options start here. , "--" , "--off" , " ()" ] 100 #+end_src See also [[#interfacing-with-window-managers][Interfacing with window managers]] below for a collection of plugins that let you interact and control xmobar from window managers. ** Icon Patterns Some monitors allow usage of strings that depend on some integer value from 0 to 8 by replacing all occurrences of =%%= with it (i.e. == will be interpreted as == when the value is =3=, also =%= is interpreted as =%=, =%%= as =3=, =%%%= as =3%=, =%%%%= as =33= and so on). Essentially it allows to replace vertical bars with custom icons. For example, #+begin_src haskell Run Brightness [ "-t", "" , "--" , "--brightness-icon-pattern", "" ] 30 #+end_src Will display =bright_0.xpm= to =bright_8.xpm= depending on current brightness value. ** Default monitor arguments These are the options available for all monitors: - =-t= /string/ Output template - Template for the monitor output. Field names must be enclosed between pointy brackets (==) 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 == (or ==) and ==. 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) - =-e= /string/ Maximum width ellipsis - Ellipsis to be added to the field when it has reached its max width. - Long option: =--maxwidthellipsis= - Default: "" (no ellipsis) - =-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) - =-T= /number/ Maximum total width - Maximum total width of the text. - Long option: =--maxtwidth= - Default: 0 (no limit) - =-E= /string/ Maximum total width ellipsis - Ellipsis to be added to the total text when it has reached its max width. - Long option: =--maxtwidthellipsis= - Default: "" (no ellipsis) - =-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 - Special value: 0. When this parameter is 0, the percentage to display is interpreted as a position in the bar foreground string (given by =-f=), and the character at that position is displayed. - =-x= /string/ N/A string - String to be used when the monitor is not available - Long option: =--nastring= - Default value: "N/A" Commands' arguments must be set as a list. E.g.: #+begin_src haskell Run Weather "EGPF" ["-t", ": C"] 36000 #+end_src 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: #+begin_src shell Glasgow Airport: 16.0C #+end_src ** Battery monitors *** =Battery Args RefreshRate= Same as #+begin_src haskell BatteryP ["BAT", "BAT0", "BAT1", "BAT2"] Args RefreshRate #+end_src *** =BatteryP Dirs Args RefreshRate= :PROPERTIES: :CUSTOM_ID: batteryp-dirs-args-refreshrate :END: - Aliases to =battery= - Dirs: list of directories in =/sys/class/power_supply/= where to look for the ACPI files of each battery. Example: =["BAT0","BAT1","BAT2"]=. Only up to 3 existing directories will be searched. - 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") - =-i=: string for AC "idle" status (default: "On") - =-o=: string for AC "off" status (default: "Off") - =-L=: low power (=watts=) threshold (default: 10) - =-H=: high power threshold (default: 12) - =-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 higher 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") - =-A=: a number between 0 and 100, threshold below which the action given by =-a=, if any, is performed (default: 5) - =-a=: a string with a system command that is run when the percentage left in the battery is less or equal than the threshold given by the =-A= option. If not present, no action is undertaken. - =-P=: to include a percentage symbol in =left=. - =--on-icon-pattern=: dynamic string for current battery charge when AC is "on" in =leftipat=. - =--off-icon-pattern=: dynamic string for current battery charge when AC is "off" in =leftipat=. - =--idle-icon-pattern=: dynamic string for current battery charge when AC is "idle" in =leftipat=. - =--lows=: string for AC "off" status and power lower than the =-L= threshold (default: "") - =--mediums=: string for AC "off" status and power lower than the =-H= threshold (default: "") - =--highs=: string for AC "off" status and power higher than the =-H= threshold (default: "") - Variables that can be used with the =-t/--template= argument: =left=, =leftbar=, =leftvbar=, =leftipat=, =timeleft=, =watts=, =acstatus= - Default template: =Batt: , % / = - Example (note that you need "--" to separate regular monitor options from Battery's specific ones): #+begin_src haskell Run BatteryP ["BAT0"] ["-t", " (%)", "-L", "10", "-H", "80", "-p", "3", "--", "-O", "On - ", "-i", "", "-L", "-15", "-H", "-5", "-l", "red", "-m", "blue", "-h", "green", "-a", "notify-send -u critical 'Battery running out!!'", "-A", "3"] 600 #+end_src In the above example, the thresholds before the =--= separator affect only the == and == fields, while those after the separator affect how == is displayed. For this monitor, neither the generic nor the specific options have any effect on ==. We are also telling the monitor to execute the unix command =notify-send= when the percentage left in the battery reaches 6%. It is also possible to specify template variables in the =-O= and =-o= switches, as in the following example: #+begin_src haskell Run BatteryP ["BAT0"] ["-t", "" , "-L", "10", "-H", "80" , "-l", "red", "-h", "green" , "--", "-O", "Charging", "-o", "Battery: %" ] 10 #+end_src - The "idle" AC state is selected whenever the AC power entering the battery is zero. *** =BatteryN Dirs Args RefreshRate Alias= Works like =BatteryP=, but lets you specify an alias for the monitor other than "battery". Useful in case you one separate monitors for more than one battery. ** Cpu and Memory monitors *** =Cpu Args RefreshRate= - Aliases to =cpu= - Args: default monitor arguments, plus: - =--load-icon-pattern=: dynamic string for cpu load in =ipat= - Thresholds refer to percentage of CPU load - Variables that can be used with the =-t/--template= argument: =total=, =bar=, =vbar=, =ipat=, =user=, =nice=, =system=, =idle=, =iowait= - Default template: =Cpu: %= *** =MultiCpu Args RefreshRate= - Aliases to =multicpu= - Args: default monitor arguments, plus: - =--load-icon-pattern=: dynamic string for overall cpu load in =ipat=. - =--load-icon-patterns=: dynamic string for each cpu load in =autoipat=, =ipat{i}=. This option can be specified several times. nth option corresponds to nth cpu. - =--fallback-icon-pattern=: dynamic string used by =autoipat= and =ipat{i}= when no =--load-icon-patterns= has been provided for =cpu{i}= - =--contiguous-icons=: flag (no value needs to be provided) that causes the load icons to be drawn without padding. - Thresholds refer to percentage of CPU load - Variables that can be used with the =-t/--template= argument: =autototal=, =autobar=, =autovbar=, =autoipat=, =autouser=, =autonice=, =autosystem=, =autoidle=, =total=, =bar=, =vbar=, =ipat=, =user=, =nice=, =system=, =idle=, =total0=, =bar0=, =vbar0=, =ipat0=, =user0=, =nice0=, =system0=, =idle0=, ... The auto* variables automatically detect the number of CPUs on the system and display one entry for each. - Default template: =Cpu: %= *** =CpuFreq Args RefreshRate= - Aliases to =cpufreq= - Args: default monitor arguments - Thresholds refer to frequency in GHz - Variables that can be used with the =-t/--template= argument: =cpu0=, =cpu1=, .., =cpuN=, give the current frequency of the respective CPU core, and =max=, =min= and =avg= the maximum, minimum and average frequency over all available cores. - Default template: =Freq: GHz= - This monitor requires the ~acpi_cpufreq~ module to be loaded in kernel - Example: #+begin_src haskell Run CpuFreq ["-t", "Freq:|GHz", "-L", "0", "-H", "2", "-l", "lightblue", "-n","white", "-h", "red"] 50 Run CpuFreq ["-t", "Freq: GHz", "-L", "0", "-H", "2", "-l", "lightblue", "-n","white", "-h", "red"] 50 #+end_src *** =CoreTemp Args RefreshRate= - Aliases to =coretemp= - Args: default monitor arguments - Thresholds refer to temperature in degrees - Variables that can be used with the =-t/--template= argument: =core0=, =core1=, .., =coreN= - Default template: =Temp: C= - This monitor requires coretemp module to be loaded in kernel - Example: #+begin_src haskell Run CoreTemp ["-t", "Temp:|C", "-L", "40", "-H", "60", "-l", "lightblue", "-n", "gray90", "-h", "red"] 50 #+end_src *** =MultiCoreTemp Args RefreshRate= - Aliases to =multicoretemp= - Args: default monitor arguments, plus: - =--max-icon-pattern=: dynamic string for overall cpu load in =maxipat=. - =--avg-icon-pattern=: dynamic string for overall cpu load in =avgipat=. - =--mintemp=: temperature in degree Celsius, that sets the lower limit for percentage calculation. - =--maxtemp=: temperature in degree Celsius, that sets the upper limit for percentage calculation. - =--hwmon-path=: this monitor tries to find coretemp devices by looking for them in directories following the pattern =/sys/bus/platform/devices/coretemp.*/hwmon/hwmon*=, but some processors (notably Ryzen) might expose those files in a different tree (e.g., Ryzen) puts them somewhere in "/sys/class/hwmon/hwmon*", and the lookup is most costly. With this option, it is possible to explicitly specify the full path to the directory where the =tempN_label= and =tempN_input= files are located. - Thresholds refer to temperature in degree Celsius - Variables that can be used with the =-t/--template= argument: =max=, =maxpc=, =maxbar=, =maxvbar=, =maxipat=, =avg=, =avgpc=, =avgbar=, =avgvbar=, =avgipat=, =core0=, =core1=, ..., =coreN= The /pc, /bar, /vbar and /ipat variables are showing percentages on the scale defined by =--mintemp= and =--maxtemp=. The max* and avg* variables to the highest and the average core temperature. - Default template: =Temp: °C - %= - This monitor requires coretemp module to be loaded in kernel - Example: #+begin_src haskell Run MultiCoreTemp ["-t", "Temp: °C | %", "-L", "60", "-H", "80", "-l", "green", "-n", "yellow", "-h", "red", "--", "--mintemp", "20", "--maxtemp", "100"] 50 #+end_src *** =K10Temp Slot Args RefreshRate= - Aliases to =k10temp= - Slot: The PCI slot address of the k10temp device as a string. You can find it as a subdirectory in =/sys/bus/pci/drivers/k10temp/=. - Args: default monitor arguments - Thresholds refer to temperature in degrees - Variables that can be used with the =-t/--template= argument: =Tctl=, =Tdie=, =Tccd1=, .., =Tccd8= - Default template: =Temp: C= - This monitor requires k10temp module to be loaded in kernel - It is important to note that not all measurements are available on on all models of processor. Of particular importance - Tdie (used in the default template) may not be present on processors prior to Zen (17h). Tctl, however, may be offset from the real temperature and so is not used by default. - Example: #+begin_src haskell Run K10Temp "0000:00:18.3" ["-t", "Temp: C|C", "-L", "40", "-H", "60", "-l", "lightblue", "-n", "gray90", "-h", "red"] 50 #+end_src *** =Memory Args RefreshRate= - Aliases to =memory= - Args: default monitor arguments, plus: - =--used-icon-pattern=: dynamic string for used memory ratio in =usedipat=. - =--free-icon-pattern=: dynamic string for free memory ratio in =freeipat=. - =--available-icon-pattern=: dynamic string for available memory ratio in =availableipat=. - =--scale=: sizes (total, free, etc.) are reported in units of ~Mb/scale~, with scale defaulting to 1.0. So, for instance, to get sizes reported in Gb, set this parameter to 1024. - Thresholds refer to percentage of used memory - Variables that can be used with the =-t/--template= argument: =total=, =free=, =buffer=, =cache=, =available=, =used=, =usedratio=, =usedbar=, =usedvbar=, =usedipat=, =freeratio=, =freebar=, =freevbar=, =freeipat=, =availableratio=, =availablebar=, =availablevbar=, =availableipat= - Default template: =Mem: % (M)= - Examples: #+begin_src haskell -- A monitor reporting memory used in Gb Memory [ "-t", " Gb", "--", "--scale", "1024"] 20 -- As above, but using one decimal digit to print numbers Memory [ "-t", " Gb", "-d", "1", "--", "--scale", "1024"] 20 #+end_src *** =Swap Args RefreshRate= - Aliases to =swap= - Args: default monitor arguments - Thresholds refer to percentage of used swap - Variables that can be used with the =-t/--template= argument: =total=, =used=, =free=, =usedratio= - Default template: =Swap: %= ** Date monitors *** =Date Format Alias RefreshRate= - Format is a time format string, as accepted by the standard ISO C =strftime= function (or Haskell's =formatCalendarTime=). Basically, if =date +"my-string"= works with your command then =Date= will handle it correctly. - Timezone changes are picked up automatically every minute. - Sample usage: #+begin_src haskell Run Date "%a %b %_d %Y %H:%M:%S" "date" 10 #+end_src *** =DateZone Format Locale Zone Alias RefreshRate= A variant of the =Date= monitor where one is able to explicitly set the time-zone, as well as the locale. - The format of =DateZone= is exactly the same as =Date=. - If =Locale= is =""= (the empty string) the default locale of the system is used, otherwise use the given locale. If there are more instances of =DateZone=, using the empty string as input for =Locale= is not recommended. - =Zone= is the name of the =TimeZone=. It is assumed that the time-zone database is stored in =/usr/share/zoneinfo/=. If the empty string is given as =Zone=, the default system time is used. - Sample usage: #+begin_src haskell Run DateZone "%a %H:%M:%S" "de_DE.UTF-8" "Europe/Vienna" "viennaTime" 10 #+end_src ** Disk monitors *** =DiskU Disks Args RefreshRate= - Aliases to =disku= - Disks: list of pairs of the form (device or mount point, template), where the template can contain ==, ==, ==, == or ==, ==, ==, ==, ==, == or == for total, free, used, free percentage and used percentage of the given file system capacity. - Thresholds refer to usage percentage. - Args: default monitor arguments. =-t/--template= is ignored. Plus - =--free-icon-pattern=: dynamic string for free disk space in =freeipat=. - =--used-icon-pattern=: dynamic string for used disk space in =usedipat=. - Default template: none (you must specify a template for each file system). - Example: #+begin_src haskell DiskU [("/", "/"), ("sdb1", "")] ["-L", "20", "-H", "50", "-m", "1", "-p", "3"] 20 #+end_src *** =DiskIO Disks Args RefreshRate= - Aliases to =diskio= - Disks: list of pairs of the form (device or mount point, template), where the template can contain ==, ==, == for total, read and write speed, respectively, as well as ==, ==, ==, which report number of bytes during the last refresh period rather than speed. There are also bar versions of each: ==, ==, ==, ==, ==, ==, ==, ==, and ==; and their "bytes" counterparts: ==, ==, ==, ==, ==, ==, ==, ==, and ==. - Thresholds refer to speed in b/s - Args: default monitor arguments. =-t/--template= is ignored. Plus - =--total-icon-pattern=: dynamic string for total disk I/O in ==. - =--write-icon-pattern=: dynamic string for write disk I/O in ==. - =--read-icon-pattern=: dynamic string for read disk I/O in ==. - Default template: none (you must specify a template for each file system). - Example: #+begin_src haskell DiskIO [("/", " "), ("sdb1", "")] [] 10 #+end_src ** Keyboard and screen monitors *** =Kbd Opts= - Registers to XKB/X11-Events and output the currently active keyboard layout. Supports replacement of layout names. - Aliases to =kbd= - Opts is a list of tuples: - first element of the tuple is the search string - second element of the tuple is the corresponding replacement - Example: #+begin_src haskell Run Kbd [("us(dvorak)", "DV"), ("us", "US")] #+end_src *** =Brightness Args RefreshRate= - Aliases to =bright= - 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: actual_brightness) - =-M=: file with the maximum brightness (default: max_brightness) - =--brightness-icon-pattern=: dynamic string for current brightness in =ipat=. - Variables that can be used with the =-t/--template= argument: =vbar=, =percent=, =bar=, =ipat= - Default template: == - Example: #+begin_src haskell Run Brightness ["-t", ""] 60 #+end_src *** =Locks= - Displays the status of Caps Lock, Num Lock and Scroll Lock. - Aliases to =locks= - Example: #+begin_src haskell Run Locks #+end_src ** Load and Process monitors *** =Load Args RefreshRate= - Aliases to =load= - Args: default monitor arguments. The low and high thresholds (=-L= and =-H=) refer to load average values. - Variables that can be used with the =-t/--template= argument: =load1=, =load5=, =load15=. - Default template: =Load: =. - Displays load averages for the last 1, 5 or 15 minutes as reported by, e.g., ~uptime(1)~. The displayed values are float, so that the ~"-d"~ option will control how many decimal digits are shown (zero by default). - Example: to have 2 decimal digits displayed, with a low threshold at 1.0 and a high one at 3, you'd write something like: #+begin_src haskell Run Load ["-t" , " " , "-L", "1", "-H", "3", "-d", "2"]) 300 #+end_src *** =TopProc Args RefreshRate= - Aliases to =top= - 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 of =cpuN=, which takes values between 0 and 100). - Variables that can be used with the =-t/--template= argument: =no=, =name1=, =cpu1=, =both1=, =mname1=, =mem1=, =mboth1=, =name2=, =cpu2=, =both2=, =mname2=, =mem2=, =mboth2=, ... - Default template: == - Displays the name and cpu/mem usage of running processes (=bothn= and =mboth= display both, and is useful to specify an overall maximum and/or minimum width, using the =-m/-M= arguments. =no= gives the total number of processes. *** =TopMem Args RefreshRate= - Aliases to =topmem= - 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: =name1=, =mem1=, =both1=, =name2=, =mem2=, =both2=, ... - Default template: == - Displays the name and RSS (resident memory size) of running processes (=bothn= displays both, and is useful to specify an overall maximum and/or minimum width, using the =-m/-M= arguments. ** Thermal monitors *** =ThermalZone Number Args RefreshRate= - Aliases to "thermaln": so =ThermalZone 0 []= can be used in template as =%thermal0%= - Thresholds refer to temperature in degrees - Args: default monitor arguments - Variables that can be used with the =-t/--template= argument: =temp= - Default template: =C= - This plugin works only on systems with devices having thermal zone. Check directories in =/sys/class/thermal= for possible values of the zone number (e.g., 0 corresponds to =thermal_zone0= in that directory). - Example: #+begin_src haskell Run ThermalZone 0 ["-t",": C"] 30 #+end_src *** =Thermal Zone Args RefreshRate= - *This plugin is deprecated. Use =ThermalZone= instead.* - Aliases to the Zone: so =Thermal "THRM" []= can be used in template as =%THRM%= - Args: default monitor arguments - Thresholds refer to temperature in degrees - Variables that can be used with the =-t/--template= argument: =temp= - Default template: =Thm: C= - This plugin works only on systems with devices having thermal zone. Check directories in /proc/acpi/thermal_zone for possible values. - Example: #+begin_src haskell Run Thermal "THRM" ["-t","iwl4965-temp: C"] 50 #+end_src ** Volume monitors *** =Volume Mixer Element Args RefreshRate= - Aliases to the mixer name and element name separated by a colon. Thus, =Volume "default" "Master" [] 10= can be used as =%default:Master%=. - Args: default monitor arguments. Also accepts: - =-O= /string/ On string - The string used in place of == when the mixer element is on. Defaults to "[on]". - Long option: =--on= - =-o= /string/ Off string - The string used in place of == when the mixer element is off. Defaults to "[off]". - Long option: =--off= - =-C= /color/ On color - The color to be used for == when the mixer element is on. Defaults to "green". - Long option: =--onc= - =-c= /color/ Off color - The color to be used for == when the mixer element is off. Defaults to "red". - Long option: =--offc= - =--highd= /number/ High threshold for dB. Defaults to -5.0. - =--lowd= /number/ Low threshold for dB. Defaults to -30.0. - =--volume-icon-pattern= /string/ dynamic string for current volume in =volumeipat=. - =-H= /number/ High threshold for volume (in %). Defaults to 60.0. - Long option: =--highv= - =-L= /number/ Low threshold for volume (in %). Defaults to 20.0. - Long option: =--lowv= - =-h=: /string/ High string - The string added in front of == when the mixer element is on and the volume percentage is higher than the =-H= threshold. Defaults to "". - Long option: =--highs= - =-m=: /string/ Medium string - The string added in front of == when the mixer element is on and the volume percentage is lower than the =-H= threshold. Defaults to "". - Long option: =--mediums= - =-l=: /string/ Low string - The string added in front of == when the mixer element is on and the volume percentage is lower than the =-L= threshold. Defaults to "". - Long option: =--lows= - Variables that can be used with the =-t/--template= argument: =volume=, =volumebar=, =volumevbar=, =volumeipat=, =dB=, =status=, =volumestatus= - Note that =dB= might only return 0 on your system. This is known to happen on systems with a pulseaudio backend. - Default template: =Vol: % = - Requires the package [[http://hackage.haskell.org/package/alsa-core][alsa-core]] and [[http://hackage.haskell.org/package/alsa-mixer][alsa-mixer]] installed in your system. In addition, to activate this plugin you must pass the =with_alsa= flag during compilation. *** =Alsa Mixer Element Args= Like [[=Volume Mixer Element Args RefreshRate=][Volume]] but with the following differences: - Uses event-based refreshing via =alsactl monitor= instead of polling, so it will refresh instantly when there's a volume change, and won't use CPU until a change happens. - Aliases to =alsa:= followed by the mixer name and element name separated by a colon. Thus, =Alsa "default" "Master" []= can be used as =%alsa:default:Master%=. - Additional options (after the =--=): - =--alsactl=/path/to/alsactl=: If this option is not specified, =alsactl= will be sought in your =PATH= first, and failing that, at =/usr/sbin/alsactl= (this is its location on Debian systems. =alsactl monitor= works as a non-root user despite living in =/usr/sbin=.). - =stdbuf= (from coreutils) must be (and most probably already is) in your =PATH=. ** Mail monitors *** =Mail Args Alias= - Args: list of maildirs in form =[("name1","path1"),...]=. Paths may start with a '~' to expand to the user's home directory. - This plugin requires inotify support in your Linux kernel and the [[http://hackage.haskell.org/package/hinotify/][hinotify]] package. To activate, pass the =with_inotify= flag during compilation. - Example: #+begin_src haskell Run Mail [("inbox", "~/var/mail/inbox"), ("lists", "~/var/mail/lists")] "mail" #+end_src *** =MailX Args Opts Alias= - Args: list of maildirs in form =[("name1","path1","color1"),...]=. Paths may start with a '~' to expand to the user's home directory. When mails are present, counts are displayed with the given name and color. - Opts is a possibly empty list of options, as flags. Possible values: -d dir --dir dir a string giving the base directory where maildir files with a relative path live. -p prefix --prefix prefix a string giving a prefix for the list of displayed mail counts -s suffix --suffix suffix a string giving a suffix for the list of displayed mail counts - This plugin requires inotify support in your Linux kernel and the [[http://hackage.haskell.org/package/hinotify/][hinotify]] package. To activate, pass the =with_inotify= flag during compilation. - Example: #+begin_src haskell Run MailX [("I", "inbox", "green"), ("L", "lists", "orange")] ["-d", "~/var/mail", "-p", " ", "-s", " "] "mail" #+end_src *** =MBox Mboxes Opts Alias= - Mboxes a list of mbox files of the form =[("name", "path", "color")]=, where name is the displayed name, path the absolute or relative (to BaseDir) path of the mbox file, and color the color to use to display the mail count (use an empty string for the default). - Opts is a possibly empty list of options, as flags. Possible values: -a --all (no arg) Show all mailboxes, even if empty. -u (no arg) Show only the mailboxes' names, sans counts. -d dir --dir dir a string giving the base directory where mbox files with a relative path live. -p prefix --prefix prefix a string giving a prefix for the list of displayed mail counts -s suffix --suffix suffix a string giving a suffix for the list of displayed mail counts - Paths may start with a '~' to expand to the user's home directory. - This plugin requires inotify support in your Linux kernel and the [[http://hackage.haskell.org/package/hinotify/][hinotify]] package. To activate, pass the =with_inotify= flag during compilation. - Example. The following command look for mails in =/var/mail/inbox= and =~/foo/mbox=, and will put a space in front of the printed string (when it's not empty); it can be used in the template with the alias =mbox=: #+begin_src haskell Run MBox [("I ", "inbox", "red"), ("O ", "~/foo/mbox", "")] ["-d", "/var/mail/", "-p", " "] "mbox" #+end_src *** =NotmuchMail Alias Args Rate= This plugin checks for new mail, provided that this mail is indexed by =notmuch=. In the =notmuch= spirit, this plugin checks for new *threads* and not new individual messages. - Alias: What name the plugin should have in your template string. - Args: A list of =MailItem= s of the form #+begin_src haskell [ MailItem "name" "address" "query" ... ] #+end_src where - =name= is what gets printed in the status bar before the number of new threads. - =address= is the e-mail address of the recipient, i.e. we only query mail that was send to this particular address (in more concrete terms, we pass the address to the =to:= constructor when performing the search). If =address= is empty, we search through all unread mail, regardless of whom it was sent to. - =query= is funneled to =notmuch search= verbatim. For the general query syntax, consult =notmuch search --help=, as well as =notmuch-search-terms(7)=. Note that the =unread= tag is *always* added in front of the query and composed with it via an *and*. - Rate: Rate with which to update the plugin (in deciseconds). - Example: - A single =MailItem= that displays all unread threads from the given address: #+begin_src haskell MailItem "mbs:" "soliditsallgood@mailbox.org" "" #+end_src - A single =MailItem= that displays all unread threads with "[My-Subject]" somewhere in the title: #+begin_src haskell MailItem "S:" "" "subject:[My-Subject]" #+end_src - A full example of a =NotmuchMail= configuration: #+begin_src haskell Run NotmuchMail "mail" -- name for the template string [ -- All unread mail to the below address, but nothing that's tagged -- with @lists@ or @haskell@. MailItem "mbs:" "soliditsallgood@mailbox.org" "not tag:lists and not tag:haskell" -- All unread mail that has @[Haskell-Cafe]@ in the subject line. , MailItem "C:" "" "subject:[Haskell-Cafe]" -- All unread mail that's tagged as @lists@, but not @haskell@. , MailItem "H:" "" "tag:lists and not tag:haskell" ] 600 -- update every 60 seconds #+end_src ** Music monitors *** =MPD Args RefreshRate= - This monitor will only be compiled if you ask for it using the =with_mpd= flag. It needs [[http://hackage.haskell.org/package/libmpd/][libmpd]] 5.0 or later (available on Hackage). - Aliases to =mpd= - 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 mpd server to communicate with, unless given in the additional arguments =-p= (=--port=) and =-h= (=--host=). Also available: - =lapsed-icon-pattern=: dynamic string for current track position in =ipat=. - Variables that can be used with the =-t/--template= argument: =bar=, =vbar=, =ipat=, =state=, =statei=, =volume=, =length=, =lapsed=, =remaining=, =plength= (playlist length), =ppos= (playlist position), =flags= (ncmpcpp-style playback mode), =name=, =artist=, =composer=, =performer=, =album=, =title=, =track=, =file=, =genre=, =date= - Default template: =MPD: = - Example (note that you need "--" to separate regular monitor options from MPD's specific ones): #+begin_src haskell Run MPD ["-t", " (<album>) <track>/<plength> <statei> [<flags>]", "--", "-P", ">>", "-Z", "|", "-S", "><"] 10 #+end_src *** =MPDX Args RefreshRate Alias= Like =MPD= but uses as alias its last argument instead of "mpd". *** =Mpris1 PlayerName Args RefreshRate= - Aliases to =mpris1= - Requires [[http://hackage.haskell.org/package/dbus][dbus]] and [[http://hackage.haskell.org/package/text][text]] packages. To activate, pass the =with_mpris= flag during compilation. - PlayerName: player supporting MPRIS v1 protocol. Some players need this to be an all lowercase name (e.g. "spotify"), but some others don't. - Args: default monitor arguments. - Variables that can be used with the =-t/--template= argument: =album=, =artist=, =arturl=, =length=, =title=, =tracknumber= - Default template: =<artist> - <title>= - Example: #+begin_src haskell Run Mpris1 "clementine" ["-t", "<artist> - [<tracknumber>] <title>"] 10 #+end_src *** =Mpris2 PlayerName Args RefreshRate= - Aliases to =mpris2= - Requires [[http://hackage.haskell.org/package/dbus][dbus]] and [[http://hackage.haskell.org/package/text][text]] packages. To activate, pass the =with_mpris= flag during compilation. - PlayerName: player supporting MPRIS v2 protocol. Some players need this to be an all lowercase name (e.g. "spotify"), but some others don't. - 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: #+begin_src haskell Run Mpris2 "spotify" ["-t", "<artist> - [<composer>] <title>"] 10 #+end_src ** Network monitors *** =Network Interface Args RefreshRate= - Aliases to the interface name: so =Network "eth0" []= can be used as =%eth0%= - Thresholds refer to velocities expressed in B/s - Args: default monitor arguments, plus: - =--rx-icon-pattern=: dynamic string for reception rate in =rxipat=. - =--tx-icon-pattern=: dynamic string for transmission rate in =txipat=. - =--up=: string used for the =up= variable value when the interface is up. - Variables that can be used with the =-t=/=--template= argument: =dev=, =rx=, =tx=, =rxbar=, =rxvbar=, =rxipat=, =txbar=, =txvbar=, =txipat=, =up=. Reception and transmission rates (=rx= and =tx=) are displayed by default as KB/s, without any suffixes, but you can set the =-S= to "True" to make them displayed with adaptive units (KB/s, MB/s, etc.). - Default template: =<dev>: <rx>KB|<tx>KB= *** =DynNetwork Args RefreshRate= - Active interface is detected automatically - Aliases to "dynnetwork" - Thresholds are expressed in B/s - Args: default monitor arguments, plus: - =--rx-icon-pattern=: dynamic string for reception rate in =rxipat=. - =--tx-icon-pattern=: dynamic string for transmission rate in =txipat= - =--devices=: comma-separated list of devices to show. - Variables that can be used with the =-t=/=--template= argument: =dev=, =rx=, =tx=, =rxbar=, =rxvbar=, =rxipat=, =txbar=, =txvbar=, =txipat=. Reception and transmission rates (=rx= and =tx=) are displayed in Kbytes per second, and you can set the =-S= to "True" to make them displayed with units (the string "KB/s"). - Default template: =<dev>: <rx>KB|<tx>KB= - Example of usage of =--devices= option: =["--", "--devices", "wlp2s0,enp0s20f41"]= *** =Wireless Interface Args RefreshRate= - If set to "", first suitable wireless interface is used. - Aliases to the interface name with the suffix "wi": thus, =Wireless "wlan0" []= can be used as =%wlan0wi%=, and =Wireless "" []= as =%wi%=. - Args: default monitor arguments, plus: - =--quality-icon-pattern=: dynamic string for connection quality in =qualityipat=. - Variables that can be used with the =-t=/=--template= argument: =ssid=, =signal=, =quality=, =qualitybar=, =qualityvbar=, =qualityipat= - Thresholds refer to link quality on a =[0, 100]= scale. Note that =quality= is calculated from =signal= (in dBm) by a possibly lossy conversion. It is also not taking into account many factors such as noise level, air busy time, transcievers' capabilities and the others which can have drastic impact on the link performance. - Default template: =<ssid> <quality>= - To activate this plugin you must pass the =with_nl80211= or the =with_iwlib= flag during compilation. ** Weather monitors :PROPERTIES: :CUSTOM_ID: weather-monitors :END: *** =Weather StationID Args RefreshRate= - Aliases to the Station ID: so =Weather "LIPB" []= can be used in template as =%LIPB%= - Thresholds refer to temperature in the selected units - Args: default monitor arguments, plus: - =--weathers= /string/ : display a default string when the =weather= variable is not reported. - short option: =-w= - Default: "" - =--useManager= /bool/ : Whether to use one single manager per monitor for managing network connections or create a new one every time a connection is made. - Short option: =-m= - Default: True - Variables that can be used with the =-t/--template= argument: =station=, =stationState=, =year=, =month=, =day=, =hour=, =windCardinal=, =windAzimuth=, =windMph=, =windKnots=, =windMs=, =windKmh= =visibility=, =skyCondition=, =weather=, =tempC=, =tempF=, =dewPointC=, =dewPointF=, =rh=, =pressure= - Default template: =<station>: <tempC>C, rh <rh>% (<hour>)= - Retrieves weather information from http://tgftp.nws.noaa.gov. Here is an [[https://tgftp.nws.noaa.gov/data/observations/metar/decoded/CYLD.TXT][example]], also showcasing the kind of information that may be extracted. Here is [[https://weather.rap.ucar.edu/surface/stations.txt][a sample list of station IDs]]. *** =WeatherX StationID SkyConditions Args RefreshRate= - Works in the same way as =Weather=, but takes an additional argument, a list of pairs from sky conditions to their replacement (typically a unicode string or an icon specification). - Use the variable =skyConditionS= to display the replacement of the corresponding sky condition. All other =Weather= template variables are available as well. For example: #+begin_src haskell WeatherX "LEBL" [ ("clear", "🌣") , ("sunny", "🌣") , ("mostly clear", "🌤") , ("mostly sunny", "🌤") , ("partly sunny", "⛅") , ("fair", "🌑") , ("cloudy","☁") , ("overcast","☁") , ("partly cloudy", "⛅") , ("mostly cloudy", "🌧") , ("considerable cloudiness", "⛈")] ["-t", "<fn=2><skyConditionS></fn> <tempC>° <rh>% <windKmh> (<hour>)" , "-L","10", "-H", "25", "--normal", "black" , "--high", "lightgoldenrod4", "--low", "darkseagreen4"] 18000 #+end_src As mentioned, the replacement string can also be an icon specification, such as =("clear", "<icon=weather-clear.xbm/>")=. *** =UVMeter= - Aliases to "uv" + station id. For example: =%uv Brisbane%= or =%uv Alice Springs%= - Args: default monitor arguments, plus: - =--useManager= /bool/ : Whether to use one single manager per monitor for managing network connections or create a new one every time a connection is made. - Short option: =-m= - Default: True - /Reminder:/ Keep the refresh rate high, to avoid making unnecessary requests every time the plug-in is run. - Station IDs can be found here: http://www.arpansa.gov.au/uvindex/realtime/xml/uvvalues.xml - Example: #+begin_src haskell Run UVMeter "Brisbane" ["-H", "3", "-L", "3", "--low", "green", "--high", "red"] 900 #+end_src ** Other monitors *** =CatInt n filename= - Reads and displays an integer from the file whose path is =filename= (especially useful with files in =/sys=). - Aliases as =catn= (e.g. =Cat 0= as =cat0=, etc.) so you can have several. - Example: #+begin_src haskell Run CatInt 0 "/sys/devices/platform/thinkpad_hwmon/fan1_input" [] 50 #+end_src *** =CommandReader "/path/to/program" Alias= - Runs the given program, and displays its standard output. *** =Uptime Args RefreshRate= - Aliases to =uptime= - 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 sum of all those fields. You can set the =-S= argument to =True= to add units to the display of those numeric fields. - Default template: =Up: <days>d <hours>h <minutes>m= * Interfacing with window managers :PROPERTIES: :CUSTOM_ID: interfacing-with-window-managers :END: ** Property-based logging *** =XMonadLog= - Aliases to XMonadLog - Displays information from xmonad's =_XMONAD_LOG=. You can use this by using functions from the [[https://hackage.haskell.org/package/xmonad-contrib-0.16/docs/XMonad-Hooks-DynamicLog.html][XMonad.Hooks.DynamicLog]] module. By using the =xmonadPropLog= function in your logHook, you can write the the above property. The following shows a minimal xmonad configuration that spawns xmobar and then writes to the =_XMONAD_LOG= property. #+begin_src haskell main = do spawn "xmobar" xmonad $ def { logHook = dynamicLogString defaultPP >>= xmonadPropLog } #+end_src This plugin can be used as a sometimes more convenient alternative to =StdinReader=. For instance, it allows you to (re)start xmobar outside xmonad. *** =UnsafeXMonadLog= - Aliases to UnsafeXMonadLog - Displays any text received by xmobar on the =_XMONAD_LOG= atom. - Will not do anything to the text received. This means you can pass xmobar dynamic actions. Be careful to escape (using =<raw=…>=) or remove tags from dynamic text that you pipe through to xmobar in this way. - Sample usage: Send the list of your workspaces, enclosed by actions tags, to xmobar. This enables you to switch to a workspace when you click on it in xmobar! #+begin_src shell <action=`xdotool key alt+1`>ws1</action> <action=`xdotool key alt+1`>ws2</action> #+end_src - If you use xmonad, It is advised that you still use =xmobarStrip= for the =ppTitle= in your logHook: #+begin_src haskell myPP = defaultPP { ppTitle = xmobarStrip } main = xmonad $ def { logHook = dynamicLogString myPP >>= xmonadPropLog } #+end_src *** =XPropertyLog PropName= - Aliases to =PropName= - Reads the X property named by =PropName= (a string) and displays its value. The [[../etc/xmonadpropwrite.hs][etc/xmonadpropwrite.hs script]] in xmobar's distribution can be used to set the given property from the output of any other program or script. *** =UnsafeXPropertyLog PropName= - Aliases to =PropName= - Same as =XPropertyLog= but the input is not filtered to avoid injection of actions (cf. =UnsafeXMonadLog=). The program writing the value of the read property is responsible of performing any needed cleanups. *** =NamedXPropertyLog PropName Alias= - Aliases to =Alias= - Same as =XPropertyLog= but a custom alias can be specified. *** =UnsafeNamedXPropertyLog PropName Alias= - Aliases to =Alias= - Same as =UnsafeXPropertyLog=, but a custom alias can be specified. ** Logging via Stdin *** =StdinReader= - Aliases to StdinReader - Displays any text received by xmobar on its standard input. - Strips actions from the text received. This means you can't pass dynamic actions via stdin. This is safer than =UnsafeStdinReader= because there is no need to escape the content before passing it to xmobar's standard input. *** =UnsafeStdinReader= - Aliases to UnsafeStdinReader - Displays any text received by xmobar on its standard input. - Similar to [[=UnsafeXMonadLog=][UnsafeXMonadLog]], in the sense that it does not strip any actions from the received text, only using =stdin= and not a property atom of the root window. Please be equally carefully when using this as when using =UnsafeXMonadLog=! ** Pipe-based logging *** =PipeReader "default text:/path/to/pipe" Alias= - Reads its displayed output from the given pipe. - Prefix an optional default text separated by a colon - Expands environment variables in the first argument of syntax =${VAR}= or =$VAR= *** =MarqueePipeReader "default text:/path/to/pipe" (length, rate, sep) Alias= - Generally equivalent to PipeReader - Text is displayed as marquee with the specified length, rate in 10th seconds and separator when it wraps around #+begin_src haskell Run MarqueePipeReader "/tmp/testpipe" (10, 7, "+") "mpipe" #+end_src - Expands environment variables in the first argument *** =BufferedPipeReader Alias [(Timeout, Bool, "/path/to/pipe1"), ..]= - 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 Timeout 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: #+begin_src haskell Run BufferedPipeReader "bpr" [ ( 0, False, "/tmp/xmobar_window" ) , ( 15, True, "/tmp/xmobar_status" ) ] #+end_src 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 [[../etc/status.sh][etc/status.sh]] - Expands environment variables for the pipe path ** Handle-based logging *** =HandleReader Handle Alias= - Display data from a Haskell =Handle= - This plugin is only useful if you are running xmobar from another Haskell program like XMonad. - You can use =System.Process.createPipe= to create a pair of =read= & =write= Handles. Pass the =read= Handle to HandleReader and write your output to the =write= Handle: #+begin_src haskell (readHandle, writeHandle) <- createPipe xmobarProcess <- forkProcess $ xmobar myConfig { commands = Run (HandleReader readHandle "handle") : commands myConfig } hPutStr writeHandle "Hello World" #+end_src ** Software Transactional Memory When invoking xmobar from other Haskell code it can be easier and more performant to use shared memory. The following plugins leverage =Control.Concurrent.STM= to realize these gains for xmobar. *** =QueueReader (TQueue a) (a -> String) String= - Display data from a Haskell =TQueue a=. - This plugin is only useful if you are running xmobar from another haskell program like xmonad. - You should make an =IO= safe =TQueue a= with =Control.Concurrent.STM.newTQueueIO=. Write to it from the user code with =writeTQueue=, and read with =readTQueue=. A common use is to overwite =ppOutput= from =XMonad.Hooks.DynamicLog= as shown below. #+begin_src haskell main :: IO () main = do initThreads q <- STM.newTQueueIO @String bar <- forkOS $ xmobar myConf { commands = Run (QueueReader q id "XMonadLog") : commands myConf } xmonad $ def { logHook = logWorkspacesToQueue q } logWorkspacesToQueue :: STM.TQueue String -> X () logWorkspacesToQueue q = dynamicLogWithPP def { ppOutput = STM.atomically . STM.writeTQueue q } #+end_src Note that xmonad uses blocking Xlib calls in its event loop and isn't normally compiled with [[https://downloads.haskell.org/~ghc/latest/docs/html/users_guide/using-concurrent.html][the threaded RTS]] so an xmobar thread running inside xmonad will suffer from delayed updates. It is thus necessary to enable =-threaded= when compiling xmonad configuration (=xmonad.hs=), e.g. by using a custom =~/.xmonad/build= script. * Executing external commands In order to execute an external command you can either write the command name in the template, in this case it will be executed without arguments, or you can configure it in the "commands" configuration option list with the Com template command: =Com ProgramName Args Alias RefreshRate= - ProgramName: the name of the program - Args: the arguments to be passed to the program at execution time - RefreshRate: number of tenths of second between re-runs of the command. A zero or negative rate means that the command will be executed only once. - Alias: a name to be used in the template. If the alias is en empty string the program name can be used in the template. E.g.: #+begin_src haskell Run Com "uname" ["-s","-r"] "" 0 #+end_src can be used in the output template as =%uname%= (and xmobar will call /uname/ only once), while #+begin_src haskell Run Com "date" ["+\"%a %b %_d %H:%M\""] "mydate" 600 #+end_src can be used in the output template as =%mydate%=. Sometimes, you don't mind if the command executed exits with an error, or you might want to display a custom message in that case. To that end, you can use the =ComX= variant: =ComX ProgramName Args ExitMessage Alias RefreshRate= Works like =Com=, but displaying =ExitMessage= (a string) if the execution fails. For instance: #+begin_src haskell Run ComX "date" ["+\"%a %b %_d %H:%M\""] "N/A" "mydate" 600 #+end_src will display "N/A" if for some reason the =date= invocation fails. �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/doc/quick-start.org���������������������������������������������������������������������0000644�0000000�0000000�00000070154�07346545000�014660� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������#+title: Quick start: using xmobar Xmobar can either be configured using the configuration language, or [[file:using-haskell.org][used as a Haskell library]] (similar to xmonad) and compiled with your specific configuration. For an example of a configuration file using the plain configuration language, see [[../etc/xmobar.config][etc/xmobar.config]], and you can have a look at [[../etc/xmobar.hs][etc/xmobar.hs]] for an example of how to write your own xmobar using Haskell. * Command line options xmobar can be either configured with a configuration file or with command line options. In the second case, the command line options will overwrite the corresponding options set in the configuration file. Example: #+begin_src shell xmobar -B white -a right -F blue -t '%LIPB%' -c '[Run Weather "LIPB" [] 36000]' #+end_src This is the list of command line options (the output of =xmobar --help=): #+begin_example Usage: xmobar [OPTION...] [FILE] Options: -h, -? --help This help -v --verbose Emit verbose debugging messages -r --recompile Force recompilation -V --version Show version information -f font name --font=font name Font name -N font name --add-font=font name Add to the list of additional fonts -w class --wmclass=class X11 WM_CLASS property -n name --wmname=name X11 WM_NAME property -B bg color --bgcolor=bg color The background color. Default black -F fg color --fgcolor=fg color The foreground color. Default grey -i path --iconroot=path Root directory for icon pattern paths. Default '.' -A alpha --alpha=alpha Transparency: 0 is transparent, 255 is opaque. Default: 255 -o --top Place xmobar at the top of the screen -b --bottom Place xmobar at the bottom of the screen -d --dock Don't override redirect from WM and function as a dock -a alignsep --alignsep=alignsep Separators for left, center and right text alignment. Default: '}{' -s char --sepchar=char Character used to separate commands in the output template. Default '%' -t template --template=template Output template -c commands --commands=commands List of commands to be executed -C command --add-command=command Add to the list of commands to be executed -x screen --screen=screen On which X screen number to start -p position --position=position Specify position of xmobar. Same syntax as in config file -T [format] --text[=format] Write output to stdout -D dpi --dpi=dpi The DPI scaling factor. Default 96.0 Mail bug reports and suggestions to <mail@jao.io> #+end_example * Configuration options :PROPERTIES: :CUSTOM_ID: configuration-options :END: ** Global options Here are all the global options that you can set within the =Config= block in your configuration and will define the overall behaviour and looks of your bar. *** Fonts :PROPERTIES: :CUSTOM_ID: fonts :END: The following configuration options control the fonts used by xmobar: - =font= Name, as a string, of the default font to use. - =additionalFonts= Haskell-style list of fonts to us with the =fn=-template. See also =textOffsets= below. For example: #+begin_src haskell additionalFonts = [iconFont, altIconFont] #+end_src - =dpi= The DPI scaling factor, as a decimal, to use. If 0, negative, or not given, the default of 96 will be used, which corresponds to an average screen. A 10pt font will therefore scale to 10pt * (1/72 pt/inch) * (96 pixel/inch) = 13.3 pixel. This is especially useful for HiDPI displays. The global font is used by default when none of the others is specified using the ~<fn=n>...</fn>~ markup, with ~n~ a 1-based index in the ~additionalFonts~ array. So, for instance #+begin_src <fn=2>some text</fn> #+end_src will use, in the configuration above, ~altIconFont~ to display "some text". Font names use the [[https://docs.gtk.org/Pango/type_func.FontDescription.from_string.html][Pango format]]. Here are a few simple examples: #+begin_example DejaVu Sans Mono 10 Iosevka Comfy Semi-Bold Italic 12 Noto Color Emoji 10 #+end_example We start with a family name (DejaVu Sans Mono, Iosevka Comfy, etc.), followed by optional, space-separated /style options/ (Semi-Bold Italic in the second example above), and ending with a size, in points. There are many possible style options (if your font supports them). They can be - *Plain styles*: Normal, Roman, Oblique, Italic. - *Variants*: Small-Caps, All-Small-Caps, Petite-Caps, All-Petite-Caps, Unicase, Title-Caps. - *Weights*: Thin, Ultra-Light, Extra-Light, Light, Semi-Ligh, Demi-Light, Book, Regular, Medium, Semi-Bold, Demi-Bold, Bold, Ultra-Bold, Extra-Bold, Heavy, Black, Ultra-Black, Extra-Black. - *Strectch values:* Thin, Ultra-Light, Extra-Light, Light, Semi-Light, Demi-Light, Book, Regular, Medium, Semi-Bold, Demi-Bold, Bold, Ultra-Bold, Extra-Bold, Heavy, Black, Ultra-Black, Extra-Black. - *Gravity values*: Not-Rotated, South, Upside-Down, North, Rotated-Left, East, Rotated-Right, West. So you can add up to 5 style options per family: #+begin_example Monospace Italic All-Small-Caps Extra-Light Thin North 12 #+end_example It's also possible to specify a list of fonts, separating them by commas, so that they act as fallbacks when the preceding one is not able to display a given glyph. A bit confusingly, the styles and sizes come in reverse order after the families: #+begin_example Family 1, Family 2 Styles 2 Size 2, Styles 1 Size 1 #+end_example For instance you could have: #+begin_example Souce Code Pro, Noto Color Emoji Regular 12, Semi-Bold 10 #+end_example to use Source Code Pro Semi-Bold 10 when possible, and fall back to Noto Color Emoji Regular 12 for characters that the former cannot display. *** Colors - =bgColor= Background color. - =fgColor= Default font color. - =alpha= The transparency. 0 is transparent, 255 is opaque. *** Vertical offsets By default, all text and icons in the bar will be vertically centered according to the configured height of the bar. You can override that behaviour with the following options: - =textOffset= The vertical offset, in pixels, for the text baseline. If negative or not given, xmobar will try to center text vertically. - =textOffsets= A list of vertical offsets, in pixels, for the text baseline, to be used with the each of the fonts in =additionalFonts= (if any). If negative or not given, xmobar will try to center text vertically for that font. - =iconOffset= The vertical offset, in pixels, for icons bottom line. If negative or not given, xmobar will try to center icons vertically. *** Borders - =border= TopB, TopBM, BottomB, BottomBM, FullB, FullBM or NoBorder (default). TopB, BottomB, FullB take no arguments, and request drawing a border at the top, bottom or around xmobar's window, respectively. TopBM, BottomBM, FullBM take an integer argument, which is the margin, in pixels, between the border of the window and the drawn border. - =borderColor= Border color. - =borderWidth= Border width in pixels. - =iconRoot= Root folder where icons are stored. For =<icon=path/>= if path start with =/=, =./= or =../= it is interpreted as it is. Otherwise it will have #+begin_src haskell iconRoot ++ "/" #+end_src prepended to it. Default is =.=. *** Bar position - =position= Top, TopH, TopHM, TopP, TopW, TopSize, Bottom, BottomH, BottomHM, BottomP, BottomW, BottomSize or Static (with x, y, width and height). TopP and BottomP take 2 arguments: left padding and right padding. TopW and BottomW take 2 arguments: an alignment parameter (L for left, C for centered, R for Right) and an integer for the percentage width xmobar window will have in respect to the screen width. TopSize and BottomSize take 3 arguments: an alignment parameter, an integer for the percentage width, and an integer for the minimum pixel height that the xmobar window will have. TopH and BottomH take one argument (Int) which adjusts the bar height. For example: #+begin_src haskell position = TopH 30 #+end_src to make a 30 tall bar on the top, or #+begin_src haskell position = BottomH 30 #+end_src to make a 30 tall bar on the bottom of the screen. The corresponding variants ~TopHM~ and ~BottomHM~ allow you to specify, in addition to a height, margins (in pixels) with the borders of the screen (left, right top and bottom); so they take five integers as arguments. For instance, if you one a margin of 2 pixels to the left of the top bar in the above example and 4 to its right and top, you could use: #+begin_src haskell position = TopHM 30 2 4 4 0 #+end_src and similarly for ~BottomHM~. #+begin_src haskell position = BottomW C 75 #+end_src to place xmobar at the bottom, centered with the 75% of the screen width. Or #+begin_src haskell position = BottomP 120 0 #+end_src to place xmobar at the bottom, with 120 pixel indent of the left. Or #+begin_src haskell position = Static { xpos = 0 , ypos = 0, width = 1024, height = 15 } #+end_src or #+begin_src haskell position = Top #+end_src - =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. - =allDesktops= When set to True (the default), xmobar will tell the window manager explicitly to be shown in all desktops, by setting =_NET_WM_DESKTOP= to 0xffffffff. - =overrideRedirect= If you're running xmobar in a tiling window manager, you might need to set this option to =False= so that it behaves as a docked application. Defaults to =True=. - =pickBroadest= When multiple displays are available, xmobar will choose by default the first one to place itself. With this flag set to =True= (the default is =False=) it will choose the broadest one instead. - =persistent= When True the window status is fixed i.e. hiding or revealing is not possible. This option can be toggled at runtime. Defaults to False. - =wmClass= The value for the window's X11 ~WM_CLASS~ property. Defaults to "xmobar". - =wmName= The value for the window's X11 ~WM_NAME~ property. Defaults to "xmobar". *** Text output - =textOutput= When True, instead of running as an X11 application, write output to stdout, with optional color escape sequences. In this mode, icon and action specifications are ignored. Default is False. - =textOutputFormat= Plain, Ansi or Pango, to emit, when in text mode, escape color sequences using ANSI controls (for terminals) or pango markup. Default is Plain. *** Commands and monitors - =commands= The list of monitors and plugins to run, together with their individual configurations. The [[./plugins.org][plugin documentation]] details all the available monitors, and you can also create new ones using Haskell. See the [[#commands-list][commands list section]] below for more. - =sepChar= The character to be used for indicating commands in the output template (defaults to '%'). - =alignSep= a 2-character string for aligning text in the output template. See [[#bar-sections][this section]] for details. - =template= The output template: a string telling xmobar how to display the outputs of all the =commands= above. See [[#output-template][the next section]] for a full description. ** The =commands= list :PROPERTIES: :CUSTOM_ID: commands-list :END: The =commands= configuration option is a list of commands information and arguments to be used by xmobar when parsing the output template. Each member of the list consists in a command prefixed by the =Run= keyword. Each command has arguments to control the way xmobar is going to execute it. The options consist in a list of commands separated by a comma and enclosed by square parenthesis. Example: #+begin_src haskell [Run Memory ["-t","Mem: <usedratio>%"] 10, Run Swap [] 10] #+end_src to run the Memory monitor plugin with the specified template, and the swap monitor plugin, with default options, every second. And here's an example of a template for the commands above using an icon: #+begin_src haskell template = "<icon=/home/jao/.xmobar/mem.xbm/><memory> <swap>" #+end_src This example will run "xclock" command when date is clicked: #+begin_src haskell template = "<action=`xclock`>%date%</action>" #+end_src The only internal available command is =Com= (see below Executing External Commands). All other commands are provided by plugins. xmobar comes with some plugins, providing a set of system monitors, a standard input reader, an Unix named pipe reader, a configurable date plugin, and much more: we list all available plugins below. Other commands can be created as plugins with the Plugin infrastructure. See below. ** The output =template= :PROPERTIES: :CUSTOM_ID: output-template :END: The output template is how xmobar will end up printing all of your configured commands. It must contain at least one command. Xmobar will parse the template and search for the command to be executed in the =commands= configuration option. First an =alias= will be searched (some plugins, such as =Weather= or =Network=, have default aliases, see the [[./plugins.org][plugin documentation]]). After that, the command name will be tried. If a command is found, the arguments specified in the =commands= list will be used. If no command is found in the =commands= list, xmobar will ask the operating system to execute a program with the name found in the template. If the execution is not successful an error will be reported. *** Template syntax The syntax for the output template is as follows: - =%command%= will execute command and print the output. The output may contain markups to change the characters' color. - =<fc=#FF0000>string</fc>= will print =string= with =#FF0000= color (red). =<fc=#FF0000,#000000>string</fc>= will print =string= in red with a black background (=#000000=). Background absolute offsets can be specified for fonts. =<fc=#FF0000,#000000:0>string</fc>= will have a background matching the bar's height. It is also possible to specify the colour's opacity, with two additional hex digits (e.g. #FF00000aa). - =<fn=1>string</fn>= will print =string= with the first font from =additionalFonts=. The index =0= corresponds to the standard font. The standard font is also used if the index is out of bounds. - =<hspace=X/>= will insert a blank horizontal space of =X= pixels. For example, to add a blank horizontal space of 123 pixels, =<hspace=123/>= may be used. - =<box>string</box>= will print string surrounded by a box in the foreground color. The =box= tag accepts several optional arguments to tailor its looks: see next section. - =<icon=/path/to/icon.xbm/>= will insert the given bitmap. XPM image format is also supported when compiled with the =with_xpm= flag. - =<action=`command` button=12345>= will execute given command when clicked with specified buttons. If not specified, button is equal to 1 (left mouse button). Using old syntax (without backticks surrounding =command=) will result in =button= attribute being ignored. - =<raw=len:str/>= allows the encapsulation of arbitrary text =str= (which must be =len= =Char=s long, where =len= is encoded as a decimal sequence). Careful use of this and =UnsafeStdinReader=, for example, permits window managers to feed xmobar strings with =<action>= tags mixed with un-trusted content (e.g. window titles). For example, if xmobar is invoked as #+begin_src shell xmobar -c "[Run UnsafeStdinReader]" -t "%UnsafeStdinReader%" #+end_src and receives on standard input the line #+begin_src shell <action=`echo test` button=1><raw=41:<action=`echo mooo` button=1>foo</action>/></action>` #+end_src then it will display the text =<action=`echo mooo` button=1>foo</action>=, which, when clicked, will cause =test= to be echoed. See the subsections below for more information on ~<box/>~, ~<icon/>~ and ~<action/>~. - The special characters =}= and ={= are used to delimit up to three sections in the bar that are drawn and aligned independently. See [[#bar-sections][this section]] for more. *** Bar sections :PROPERTIES: :CUSTOM_ID: bar-sections :END: You can use the special characters =}= and ={= are used to delimit up to three sections in the bar, which are aligned and, if needed, overlapped according to these rules: - If the template has the form =L}M{R=, with L, R, M arbitrary specs, the monitors in =L= are drawn first, aligned to the left, then =R=, aligned to the right, and finally =M= is drawn centered in the bar. =R= is trimmed to the space left by =L=, and =M= is trimmed to the space left by =L= and =R=. - If the template has the form =L}{R=, =L= is drawn aligned to the left first and then =R=, aligned to the right and trimmed if needed to fit in the space left by =L=. - If the template has the form =}L{R=, =R= is drawn first, aligned to the right, and then =L=, aligned to the left and trimmed to the space left by =R=. When needed, sections are always trimmed on the right. The section delimiters can be changed using the configuration option =alignSep,= a two-character string. *** Boxes around text - =<box>string</box>= will print string surrounded by a box in the foreground color. The =box= tag accepts several optional arguments to tailor its looks: - =type=: =Top=, =Bottom=, =VBoth= (a single line above or below string, or both), =Left=, =Right=, =HBoth= (single vertical lines), =Full= (a rectangle, the default). - =color=: the color of the box lines. - =width=: the width of the box lines. - =offset=: an alignment char (L, C or R) followed by the amount of pixels to offset the box lines; the alignment denotes the position of the resulting line, with L/R meaning top/bottom for the vertical lines, and left/right for horizontal ones. - =mt=, =mb=, =ml=, =mr= specify margins to be added at the top, bottom, left and right lines. For example, a box underlining its text with a red line of width 2: #+begin_src shell <box type=Bottom width=2 color=red>string</box> #+end_src and if you wanted an underline and an overline with a margin of 2 pixels either side: #+begin_src shell <box type=VBoth mt=2 mb=2>string</box> #+end_src When xmobar is run in text mode with output format swaybar, box types, colors and widths are valid too, but margins and offsets are ignored. *** Bitmap icons It's possible to insert in the global templates icon directives of the form: prepended to it. Default is =.=. #+begin_src shell <icon=/path/to/bitmap.xbm/> #+end_src which will produce the expected result. Accepted image formats are XBM and XPM (when =with_xpm= flag is enabled). If path does not start with =/=, =./=, =../= it will have #+begin_src haskell iconRoot ++ "/" #+end_src prepended to it. Icons are ignored when xmobar is run in text output mode. *** Mouse actions It's also possible to use action directives of the form: #+begin_src shell <action=`command` button=12345> #+end_src which will be executed when clicked on with specified mouse buttons. This tag can be nested, allowing different commands to be run depending on button clicked. Actions work also when xmobar is run in text mode and used as the status command of swaybar. * Runtime behaviour ** Running xmobar in text mode :PROPERTIES: :CUSTOM_ID: text-mode :END: By default, xmobar will run as an X11 application, in a docked window, but it is possible to redirect xmobar's output to the standard output, optionally with color escape sequences. In this mode, xmobar can be run inside a terminal o console, or its output piped to other applications, and there is no need for an X11 display (so, for instance, you could pipe xmobar's output to a Wayland application, such as swaybar.) To run xmobar in text mode, either pass the =-T= flag to its invocation: #+begin_src shell xmobar -T /path/to/config & #+end_src or set the parameter =textOutput= to True in its configuration. You can also specify the format of color escapes, for instance, omitting them altogether with ~Plain~: #+begin_src shell xmobar -TPlain /path/to/config & #+end_src Other options are ~Ansi~, ~Pango~, and ~Swaybar~. ** Showing xmobar output in Emacs tab or mode line Using xmobar's ANSI color text ouput, one can plug it inside Emacs, and display your monitors in the mode line or the tab bar. The [[../etc/xmobar.el][xmobar.el package]] provides a simple way of doing it. ** Using xmobar in wayland with swaybar or waybar :PROPERTIES: :CUSTOM_ID: wayland :END: In text mode, xmobar can be told to ouput its information using pango markup for colors and fonts, and it that way you can use it with swaybar or waybar, if you don't have actions or boxes in your template. Here's a minimal ~bar~ configuration for sway's configuration file: #+begin_src conf bar { status_command xmobar -TPango pango_markup enabled } #+end_src In case you want to use boxes around text or click actions in your template, you can use instead the format ~Swaybar~, which supports both. This output format follows the JSON /swaybar-protocol/ defined by swaybar. Configure it simply with: #+begin_src conf bar { status_command xmobar -TSwaybar } #+end_src ** Running xmobar with =i3status= xmobar can be used to display information generated by [[http://i3wm.org/i3status/][i3status]], a small program that gathers system information and outputs it in formats suitable for being displayed by the dzen2 status bar, wmii's status bar or xmobar's =StdinReader=. See [[http://i3wm.org/i3status/manpage.html#_using_i3status_with_xmobar][i3status manual]] for further details. ** Dynamically sizing xmobar See [[https://codeberg.org/xmobar/xmobar/issues/239#issuecomment-233206552][this idea]] by Jonas Camillus Jeppensen for a way of adapting dynamically xmobar's size and run it alongside a system tray widget such as trayer or stalonetray (although the idea is not limited to trays, really). For your convenience, there is a version of Jonas' script in [[../etc/padding-icon.sh][etc/padding-icon.sh]]. ** Signal handling xmobar reacts to ~SIGUSR1~ and ~SIGUSR2~: - After receiving ~SIGUSR1~ xmobar moves its position to the next screen. - After receiving ~SIGUSR2~ xmobar repositions itself on the current screen. * The DBus interface When compiled with the optional =with_dbus= flag, xmobar can be controlled over dbus. All signals defined in [[../src/Xmobar/System/Signal.hs][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 acquire the dbus. This is handled on a first-come-first-served basis, meaning that the first process will get the dbus interface. Other processes will run without further problems, yet have no dbus interface. - 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: #+begin_src shell dbus-send \ --session \ --dest=org.Xmobar.Control \ --type=method_call \ --print-reply \ '/org/Xmobar/Control' \ org.Xmobar.Control.SendSignal \ "string:SetAlpha 192" #+end_src It is also possible to send multiple signals at once: #+begin_src shell # send to another screen, reveal and toggle the persistent flag dbus-send [..] \ "string:ChangeScreen 0" "string:Reveal 0" "string:TogglePersistent" #+end_src The =Toggle=, =Reveal=, and =Hide= signals take an additional integer argument that denotes an initial delay, in tenths of a second, before the command takes effect, while =SetAlpha= takes a new alpha value (also an integer, between 0 and 255) as argument. ** Example: 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. #+begin_src haskell ((0, xK_Alt_L), pure ()) #+end_src 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). #+begin_src haskell 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 #+end_src ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/doc/using-haskell.org�������������������������������������������������������������������0000644�0000000�0000000�00000012002�07346545000�015143� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������#+title: Using Haskell * Writing your own xmobar in Haskell :PROPERTIES: :CUSTOM_ID: xmobar-in-haskell :END: Besides an standalone program, ~xmobar~ is also a Haskell library providing an interface to write your own status bar. You can write, instead of a configuration file, a real Haskell program that will be compiled and run when you invoke =xmobar=. Make sure that ~ghc~ will be able to locate the xmobar library, e.g. with #+begin_src shell cabal install --lib xmobar #+end_src and then write your Haskell configuration and main function using the functions and types exported in the library, which closely resemble those used in configuration files. Here's a small example: #+begin_src haskell import Xmobar config :: Config config = defaultConfig { font = "DejaVu Sans Mono 9", allDesktops = True, alpha = 200, commands = [ Run XMonadLog, Run $ Memory ["t", "Mem: <usedratio>%"] 10, Run $ Kbd [], Run $ Date "%a %_d %b %Y <fc=#ee9a00>%H:%M:%S</fc>" "date" 10 ], template = "%XMonadLog% }{ %kbd% | %date% | %memory%", alignSep = "}{" } main :: IO () main = xmobar config -- or: configFromArgs config >>= xmobar #+end_src You can then for instance run =ghc --make xmobar.hs= to create a new xmobar executable running exactly the monitors defined above. Or put your =xmobar.hs= program in =~/.config/xmobar/xmobar.hs= and, when running the system-wide xmobar, it will notice that you have your own implementation and (re)compile and run it as needed. * Writing a plugin :PROPERTIES: :CUSTOM_ID: writing-a-plugin :END: Writing a plugin for xmobar is very simple! First, you need to create a data type with at least one constructor. Next you must declare this data type an instance of the =Exec= class, by defining the one needed method (alternatively =start= or =run=) and 3 optional ones (=alias=, =rate=, and =trigger=): #+begin_src haskell start :: e -> (String -> IO ()) -> IO () run :: e -> IO String rate :: e -> Int alias :: e -> String trigger :: e -> (Maybe SignalType -> IO ()) -> IO () #+end_src =start= must receive a callback to be used to display the =String= produced by the plugin. This method can be used for plugins that need to perform asynchronous actions. See =src/Xmobar/Plugins/PipeReader.hs= for an example. =run= can be used for simpler plugins. If you define only =run= the plugin will be run every second. To overwrite this default you just need to implement =rate=, which must return the number of tenth of seconds between every successive runs. See [[../etc/xmobar.hs][etc/xmobar.hs]] for an example of a plugin that runs just once, and [[../src/Xmobar/Plugins/Date.hs][src/Xmobar/Plugins/Date.hs]] for one that implements =rate=. Notice that Date could be implemented as: #+begin_src haskell instance Exec Date where alias (Date _ a _) = a start (Date f _ r) = date f r date :: String -> Int -> (String -> IO ()) -> IO () date format r callback = do go where go = do t <- toCalendarTime =<< getClockTime callback $ formatCalendarTime defaultTimeLocale format t tenthSeconds r >> go #+end_src Modulo some technicalities like refreshing the time-zone in a clever way, this implementation is equivalent to the one you can read in =Plugins/Date.hs=. =alias= is the name to be used in the output template. Default alias will be the data type constructor. After that your type constructor can be used as an argument for the Runnable type constructor =Run= in the =commands= list of the configuration options. If your plugin only implements =alias= and =start=, then it is advisable to put it into the =Xmobar/Plugins/Monitors= directory and use one of the many =run*= functions in [[../src/Xmobar/Plugins/Monitors/Common/Run.hs][Xmobar.Plugins.Monitors.Run]] in order to define =start=. The =Exec= instance should then live in [[../src/Xmobar/Plugins/Monitors.hs][Xmobar.Plugins.Monitors]]. * Using a plugin To use your new plugin, you just need to use a pure Haskell configuration for xmobar (as explained [[#xmobar-in-haskell][above]]) and load your definitions in your =xmobar.hs= file. You can see an example in [[../etc/xmobar.hs][etc/xmobar.hs]] showing you how to write a Haskell configuration that uses a new plugin, all in one file. When xmobar runs with the full path to that Haskell file as its argument (or if you put it in =~/.config/xmobar/xmobar.hs=), and with the xmobar library installed (e.g., with =cabal install --lib xmobar=), the Haskell code will be compiled as needed, and the new executable spawned for you. That's it! * Further links For an elaborated, experimental and underdocumented example of writing your own repos and status bars using xmobar, see [[https://codeberg.org/jao/xmobar-config][this repo at jao/xmobar-config]]. ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/etc/������������������������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�011677� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/etc/padding-icon.sh���������������������������������������������������������������������0000644�0000000�0000000�00000003134�07346545000�014570� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������#!/bin/bash # Detects the width of running window with name given as first # argument (xprop name '$1') and creates an XPM icon of that width, # 1px height, and transparent. Outputs an <icon>-tag for use in # xmobar to display the generated XPM icon. # # Run script from xmobar and trayer: # `Run Com "/where/ever/padding-icon.sh" ["panel"] "trayerpad" 10` # and use `%trayerpad%` in your template. # or, if you're using for instance stalonetray: # `Run Com "/where/ever/padding-icon.sh" ["stalonetray"] "tray" 10` # Very heavily based on Jonas Camillus Jeppensen code # https://codeberg.org/xmobar/xmobar/issues/239#issuecomment-233206552 # Function to create a transparent Wx1 px XPM icon create_xpm_icon () { timestamp=$(date) pixels=$(for i in `seq $1`; do echo -n "."; done) cat << EOF > "$2" /* XPM * static char * trayer_pad_xpm[] = { /* This XPM icon is used for padding in xmobar to */ /* leave room for trayer-srg. It is dynamically */ /* updated by by trayer-pad-icon.sh which is run */ /* by xmobar. */ /* Created: ${timestamp} */ /* <w/cols> <h/rows> <colors> <chars per pixel> */ "$1 1 1 1", /* Colors (none: transparent) */ ". c none", /* Pixels */ "$pixels" }; EOF } # panel window name pname=${1:-panel} # Width of the trayer window width=$(xprop -name $pname | grep 'program specified minimum size' | cut -d ' ' -f 5) # Icon file name iconfile="/tmp/$pname-padding-${width:-0}px.xpm" # If the desired icon does not exist create it if [ ! -f $iconfile ] then create_xpm_icon $width $iconfile fi # Output the icon tag for xmobar echo "<icon=${iconfile}/>" ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/etc/xmobar.config�����������������������������������������������������������������������0000644�0000000�0000000�00000003272�07346545000�014362� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������Config { font = "DejaVu Sans Mono 9" , additionalFonts = ["DejaVu Sans Mono italic 9"] , borderColor = "black" , border = FullB , bgColor = "black" , fgColor = "whitesmoke" , alpha = 128 , position = Top , textOffset = -1 , iconOffset = -1 , lowerOnStart = True , pickBroadest = False , persistent = False , hideOnStart = False , iconRoot = "." , allDesktops = True , overrideRedirect = True , textOutputFormat = Ansi , commands = [ Run Weather "EGPF" ["-t","<station>: <tempC>C", "-L","18","-H","25", "--normal","green", "--high","red", "--low","lightblue"] 36000 , Run Network "eth0" ["-L","0","-H","32", "--normal","green","--high","red"] 10 , Run Network "eth1" ["-L","0","-H","32", "--normal","green","--high","red"] 10 , Run Cpu ["-L","3","-H","50", "--normal","green","--high","red"] 10 , Run Memory ["-t","Mem: <usedratio>%"] 10 , Run Swap [] 10 , Run Com "uname" ["-s","-r"] "" 36000 , Run Date "%a %b %_d %Y %H:%M:%S" "date" 10 ] , sepChar = "%" , alignSep = "}{" , template = "%cpu% | <box>%memory% * %swap%</box> | %eth0% - %eth1% }\ \{ <fc=#ee9a00><fn=1>%date%</fn></fc>| %EGPF% | %uname%" } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/etc/xmobar.el���������������������������������������������������������������������������0000644�0000000�0000000�00000013034�07346545000�013512� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������;; xmobar.el --- Display xmobar text output -*- lexical-binding: t -*- ;; Copyright 2022 jao <jao@gnu.org> ;; Version: 0.0.1 ;; Package-Requires: ((emacs "28.1")) ;; Keywords: unix ;; Heavily inspired by Steven Allen's https://github.com/Stebalien/i3bar.el ;; This file is not part of GNU Emacs. ;; This file is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; This file is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. ;;; Commentary: ;; Displays the output of an xmobar command in the Emacs mode-line (or tab-line). ;;; Code: (eval-when-compile (require 'cl-lib)) (require 'tab-bar) (require 'xterm-color nil t) (defgroup xmobar nil "xmobar status display for Emacs." :version "0.0.1" :group 'mode-line) (defcustom xmobar-command '("xmobar" "-TAnsi") "The xmobar command and flags." :type '(choice (string :tag "Shell Command") (repeat (string)))) (defcustom xmobar-tab-bar t "Whether to dispaly xmobar output in the tab bar." :type 'boolean) (defcustom xmobar-tab-split nil "Split on this string for `xmobar-left-string' and `xmobar-right-string'." :type 'string) (defcustom xmobar-tab-bar-format '(xmobar-left-string xmobar-elastic-space xmobar-right-string) "Format for the tab bar when `xmobar-tab-bar' is t." :type 'list) (defvar xmobar--process nil "The running xmobar process, if any.") (defvar xmobar--left-string "") (defvar xmobar-string "" "The xmobar string to be displayed in the mode-line or tab-bar.") (put 'xmobar-string 'risky-local-variable t) (defvar xmobar--colorize-fn (if (featurep 'xterm-color) #'xterm-color-filter #'ansi-color-apply)) (defvar xmobar--old-tab-format tab-bar-format) (defvar xmobar--len 0) (defun xmobar-string () xmobar-string) (defun xmobar-right-string () xmobar-string) (defun xmobar-left-string () xmobar--left-string) (defun xmobar-elastic-space () (make-string (- (frame-width) xmobar--len 3) ? )) ;;;###autoload (define-minor-mode xmobar-mode "Display an xmobar in the mode-line." :global t :group 'xmobar (xmobar--stop) (if xmobar-mode (progn (if xmobar-tab-bar (progn (setq xmobar--old-tab-format tab-bar-format) (setq tab-bar-format xmobar-tab-bar-format) (tab-bar-mode 1)) (or global-mode-string (setq global-mode-string '(""))) (unless (memq 'xmobar-string global-mode-string) (add-to-list 'global-mode-string 'xmobar-string t))) (xmobar--start)) (when xmobar-tab-bar (setq tab-bar-format xmobar--old-tab-format)))) (defun xmobar--update (update) "Apply an UPDATE to the xmobar bar." (when xmobar-mode (let* ((str (funcall xmobar--colorize-fn update)) (strs (and xmobar-tab-split (split-string str xmobar-tab-split)))) (setq xmobar-string (if strs (cadr strs) str) xmobar--left-string (or (car strs) "") xmobar--len (+ (string-width xmobar--left-string) (string-width xmobar-string)))) (force-mode-line-update t))) (defun xmobar--process-filter (proc string) "Process output from the xmobar process." (let ((buf (process-buffer proc))) (when (buffer-live-p buf) (with-current-buffer buf ;; Write the input to the buffer (might be partial). (save-excursion (goto-char (process-mark proc)) (insert string) (set-marker (process-mark proc) (point))) (when (string-match-p "\n$" string) (xmobar--update (buffer-substring (point-min) (- (point-max) 1))) (delete-region (point-min) (point-max))))))) (defun xmobar--process-sentinel (proc status) "Handle events from the xmobar process (PROC). If the process has exited, this function stores the exit STATUS in `xmobar-string'." (unless (process-live-p proc) (setq xmobar--process nil) (let ((buf (process-buffer proc))) (when (and buf (buffer-live-p buf)) (kill-buffer buf))) (setq xmobar-string (format "xmobar: %s" status) xmobar--left-string ""))) (defun xmobar--start () "Start xmobar." (xmobar--stop) (condition-case err (setq xmobar--process (make-process :name "xmobar" :buffer " *xmobar process*" :stderr " *xmobar stderr*" :command (ensure-list xmobar-command) :connection-type 'pipe :noquery t :sentinel #'xmobar--process-sentinel :filter #'xmobar--process-filter)) (error (setq xmobar-string (format "starting xmobar: %s" (error-message-string err)) xmobar--left-string "")))) (defun xmobar--stop () "Stop xmobar." (when (and xmobar--process (process-live-p xmobar--process)) (delete-process xmobar--process)) (setq xmobar-string "" xmobar--left-string "")) ;;;###autoload (defun xmobar-restart () "Restart the xmobar program." (interactive) (unless xmobar-mode (user-error "The xmobar-mode is not enabled")) (xmobar--start)) (provide 'xmobar) ;;; xmobar.el ends here ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/etc/xmobar.hs���������������������������������������������������������������������������0000644�0000000�0000000�00000004755�07346545000�013536� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Copyright: (c) 2018, 2019, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sat Nov 24, 2018 21:03 -- -- -- An example of a Haskell-based xmobar. Compile it with -- ghc --make -- xmobar.hs -- with the xmobar library installed or simply call: -- xmobar /path/to/xmobar.hs -- and xmobar will compile and launch it for you and ------------------------------------------------------------------------------ import Xmobar -- Example user-defined plugin data HelloWorld = HelloWorld deriving (Read, Show) instance Exec HelloWorld where alias HelloWorld = "hw" run HelloWorld = return "<fc=red>Hello World!!</fc>" -- Configuration, using predefined monitors as well as our HelloWorld -- plugin: config :: Config config = defaultConfig { font = "xft:Sans Mono-9" , additionalFonts = [] , borderColor = "black" , border = TopB , bgColor = "black" , fgColor = "grey" , alpha = 255 , position = Top , textOffset = -1 , iconOffset = -1 , lowerOnStart = True , pickBroadest = False , persistent = False , hideOnStart = False , iconRoot = "." , allDesktops = True , overrideRedirect = True , textOutputFormat = Ansi , commands = [ Run $ Weather "EGPH" ["-t","<station>: <tempC>C", "-L","18","-H","25", "--normal","green", "--high","red", "--low","lightblue"] 36000 , Run $ Network "eth0" ["-L","0","-H","32", "--normal","green","--high","red"] 10 , Run $ Network "eth1" ["-L","0","-H","32", "--normal","green","--high","red"] 10 , Run $ Cpu ["-L","3","-H","50", "--normal","green","--high","red"] 10 , Run $ Memory ["-t","Mem: <usedratio>%"] 10 , Run $ Swap [] 10 , Run $ Com "uname" ["-s","-r"] "" 36000 , Run $ Date "%a %b %_d %Y %H:%M:%S" "date" 10 , Run HelloWorld ] , sepChar = "%" , alignSep = "}{" , template = "%cpu% | %memory% * %swap% | %eth0% - %eth1% }\ \ %hw% { <fc=#ee9a00>%date%</fc>| %EGPH% | %uname%" } main :: IO () main = configFromArgs config >>= xmobar �������������������xmobar-0.46/etc/xmonadpropwrite.hs������������������������������������������������������������������0000644�0000000�0000000�00000002146�07346545000�015500� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������-- Copyright Spencer Janssen <spencerjanssen@gmail.com> -- Tomas Janousek <tomi@nomi.cz> -- BSD3 (see LICENSE) -- -- Reads from standard input and writes to an X propery on root window. -- To be used with XPropertyLog: -- Add it to commands: -- Run XPropertyLog "_XMONAD_LOG_CUSTOM" -- Add it to the template: -- template = "... %_XMONAD_LOG_CUSTOM% ..." -- Run: -- $ blah blah | xmonadpropwrite _XMONAD_LOG_CUSTOM import Control.Monad import Graphics.X11 import Graphics.X11.Xlib.Extras import qualified Data.ByteString as B import Foreign.C (CChar) import System.IO import System.Environment main = do atom <- flip fmap getArgs $ \args -> case args of [a] -> a _ -> "_XMONAD_LOG" d <- openDisplay "" xlog <- internAtom d atom False ustring <- internAtom d "UTF8_STRING" False root <- rootWindow d (defaultScreen d) forever $ do msg <- B.getLine changeProperty8 d root xlog ustring propModeReplace (encodeCChar msg) sync d True return () encodeCChar :: B.ByteString -> [CChar] encodeCChar = map fromIntegral . B.unpack ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/license���������������������������������������������������������������������������������0000644�0000000�0000000�00000002757�07346545000�012504� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������Copyright (c) 2007-2010 Andrea Rossato Copyright (c) 2010-2020 Jose A Ortega Ruiz 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. �����������������xmobar-0.46/readme.org������������������������������������������������������������������������������0000644�0000000�0000000�00000017543�07346545000�013104� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������#+title: xmobar, a minimalistic status bar #+begin_export html <p align="right"> <a href="http://hackage.haskell.org/package/xmobar"> <img src="https://img.shields.io/hackage/v/xmobar.svg" alt="hackage"/> </a> <a href="https://ci.codeberg.org/xmobar/xmobar"> <img src="https://ci.codeberg.org/api/badges/xmobar/xmobar/status.svg" alt="ci"/> </a> </p> #+end_export Xmobar is a minimalistic status bar. It was originally designed and implemented to work with [[http://xmonad.org][xmonad]], but it is actually usable with any window manager in X11 and also (via its text output mode) Wayland. Xmobar was inspired by the [[http://tuomov.iki.fi/software/][Ion3]] status bar, and supports similar features, like dynamic color management, icons, output templates, and extensibility through plugins. It is also able to write to standard output, in a variety of formats. [[file:doc/screenshots/xmobar-top.png]] [[file:doc/screenshots/xmobar-bottom.png]] [[file:doc/screenshots/xmobar-exwm.png]] Check [[./changelog.md][the change log]] for our release history. We also have an IRC channel, ~#xmobar~, at [[ircs://irc.libera.chat][Libera]]. * Breaking news - Starting with version 0.45 we use cairo/pango as our drawing engine (instead of plain X11/Xft). From a user's point of view, that change should be mostly transparent, except for the facts that it's allowed fixing quite a few bugs and that your /font names/ in your configuration, if you used ~xft~ ones, might need to be adapted to Pango's syntax: please see [[./doc/quick-start.org#fonts][this section of the documentation]] for all the details. If you're compiling your own xmobar, there's a new dependency on libpango (see [[./doc/compiling.org#c-libraries][C library dependencies]]). * Installation :PROPERTIES: :CUSTOM_ID: installation :END: ** From your system's package manager Xmobar is probably available from your distributions package manager! Most distributions compile xmobar with the =all_extensions= flag, so you don't have to. - Arch Linux #+begin_src shell pacman -S xmobar #+end_src - Debian/Ubuntu based #+begin_src shell apt install xmobar #+end_src - OpenSUSE #+begin_src shell zypper install xmobar #+end_src - Void Linux #+begin_src shell xbps-install xmobar #+end_src - Gentoo #+begin_src shell emerge --ask xmobar #+end_src ** Using cabal or stack Xmobar is available from [[http://hackage.haskell.org/package/xmobar/][Hackage]], and you can compile and install it using =cabal-install=, making sure the [[doc/compiling.org#c-libraries][required C libraries]] are in place. For a full build with all available extensions: #+begin_src shell # required C librarises apt-get install xorg-dev libxrandr-dev libpango1.0-dev # optional C libraries for additional plugins apt-get install libasound2-dev libxpm-dev libmpd-dev cabal install xmobar -fall_extensions #+end_src Starting with version 0.35.1, xmobar requires at least GHC version 8.4.x. to build. See [[https://codeberg.org/xmobar/xmobar/issues/461][this issue]] for more information. See [[file:doc/compiling.org#optional-features][here]] for a list of optional compilation flags that will enable some optional plugins. See [[file:doc/compiling.org][compiling]] for full compilation instructions starting from source. * Running xmobar ** Running xmobar with a configuration file You can run xmobar with: #+begin_src shell xmobar /path/to/config & #+end_src or #+begin_src shell xmobar & #+end_src if you have the default configuration file saved as =$XDG_CONFIG_HOME/xmobar/xmobarrc= (defaulting to =~/.config/xmobar/xmobarrc=), or =~/.xmobarrc=. All the available command line switches and configuration parameters are described in [[file:doc/quick-start.org][the quick start guide]] and [[file:doc/plugins.org][the plugins index]]. ** Writing your own xmobar in Haskell As shown above, one can use ~xmobar~ as a regular program, via its configuration file, without having to write any code. It also is possible to install xmobar as a library and use it to write your own xmobar using Haskell instead of using a configuration file. (This is very similar to how [[http://xmonad.org][xmonad]] works.) That gives you the ability of using Haskell and its libraries to extend xmobar to your heart's content. If you are a programmer, take a look [[file:doc/using-haskell.org][here]] to learn more. ** Running xmobar in text mode By default, xmobar will run as an X11 application, in a docked window, but it is possible to redirect xmobar's output to the standard output, optionally with color escape sequences. In this mode, xmobar can be run inside a terminal o console, or its output piped to other applications, and there is no need for an X11 display. See [[./doc/quick-start.org#text-mode][Running xmobar in text mode]] for details. Using this mode, you could [[file:doc/quick-start.org#wayland][pipe xmobar's output to, say, swaybar]], and use it in wayland, or, with the [[./etc/xmobar.el][xmobar.el]] package, show it in Emacs's tab bar. * Configuration and further documentation - If you want to jump straight into running xmobar, head over to the [[./doc/quick-start.org][quick start guide]]. - If you want to get a detailed overview of all available plugins and monitors, visit the [[./doc/plugins.org][plugins index]]. - For more information on how to use xmobar as a Haskell library see the [[file:doc/using-haskell.org][using Haskell guide]]. - If you want to know how to contribute to the xmobar project, check out [[contributing.org][contributing]]. * Authors and credits Andrea Rossato originally designed and implemented xmobar up to version 0.11.1. Since then, it is maintained and developed by [[https://jao.io][jao]], with the help of the greater xmobar and Haskell communities. In particular, xmobar incorporates patches by Kostas Agnantis, Mohammed Alshiekh, Alex Ameen, Axel Angel, Dhananjay Balan, Claudio Bley, Dragos Boca, Ben Boeckel, Ivan Brennan, Duncan Burke, Roman Cheplyaka, Patrick Chilton, Antoine Eiche, Nathaniel Wesley Filardo, Guy Gastineau, John Goerzen, Jonathan Grochowski, Patrick Günther, Reto Hablützel, Juraj Hercek, Tomáš Janoušek, Ada Joule, Spencer Janssen, Roman Joost, Pavel Kalugin, Jochen Keil, Sam Kirby, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, Vanessa McHale, Robert J. Macomber, Dmitry Malikov, David McLean, Joan Milev, Marcin Mikołajczyk, Dino Morelli, Tony Morris, Eric Mrak, Thiago Negri, Edward O'Callaghan, Svein Ove, Martin Perner, Jens Petersen, Alexander Polakov, Sibi Prabakaran, Pavan Rikhi, Petr Rockai, Andrew Emmanuel Rosa, Sackville-West, Amir Saeid, Markus Scherer, Daniel Schüssler, Olivier Schneider, Alexander Shabalin, Valentin Shirokov, Peter Simons, Alexander Solovyov, Will Song, John Soo, John Soros, Felix Springer, Travis Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei Trofimovich, Thomas Tuegel, John Tyree, Jan Vornberger, Anton Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Nikolay Yakimov, Edward Z. Yang, Leo Zhang, Norbert Zeh, and Michał Zielonka. Andrea wants to thank Robert Manea and Spencer Janssen for their help in understanding how X works. They gave him suggestions on how to solve many problems with xmobar. He also thanks Claus Reinke for making him understand existential types (or at least for letting him think he grasps existential types...;-). * License This software is released under a BSD-style license. See [[https://codeberg.org/xmobar/xmobar/src/branch/master/license][license]] for more details. Copyright © 2010-2022 Jose Antonio Ortega Ruiz Copyright © 2007-2010 Andrea Rossato �������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/������������������������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�011713� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar.hs���������������������������������������������������������������������������0000644�0000000�0000000�00000005125�07346545000�013502� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar -- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017, 2018, 2019, 2022 Jose Antonio Ortega Ruiz -- (c) 2007 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Public interface of the xmobar library -- ----------------------------------------------------------------------------- module Xmobar (xmobar , xmobarMain , defaultConfig , configFromArgs , tenthSeconds , Runnable (..) , Exec (..) , Command (..) , SignalType (..) , module Xmobar.Config.Types , module Xmobar.Config.Parse , module Xmobar.Plugins.BufferedPipeReader , module Xmobar.Plugins.CommandReader , module Xmobar.Plugins.Date #ifdef DATEZONE , module Xmobar.Plugins.DateZone #endif , module Xmobar.Plugins.EWMH , module Xmobar.Plugins.HandleReader , module Xmobar.Plugins.QueueReader , module Xmobar.Plugins.Kbd , module Xmobar.Plugins.Locks #ifdef INOTIFY , module Xmobar.Plugins.Mail , module Xmobar.Plugins.MBox #endif , module Xmobar.Plugins.NotmuchMail , module Xmobar.Plugins.Monitors , module Xmobar.Plugins.PipeReader , module Xmobar.Plugins.MarqueePipeReader , module Xmobar.Plugins.StdinReader , module Xmobar.Plugins.XMonadLog ) where import Xmobar.Run.Runnable import Xmobar.Run.Exec import Xmobar.Config.Types import Xmobar.Config.Parse import Xmobar.Plugins.Command import Xmobar.Plugins.BufferedPipeReader import Xmobar.Plugins.CommandReader import Xmobar.Plugins.Date #ifdef DATEZONE import Xmobar.Plugins.DateZone #endif import Xmobar.Plugins.EWMH import Xmobar.Plugins.HandleReader import Xmobar.Plugins.QueueReader import Xmobar.Plugins.Kbd import Xmobar.Plugins.Locks #ifdef INOTIFY import Xmobar.Plugins.Mail import Xmobar.Plugins.MBox #endif import Xmobar.Plugins.Monitors import Xmobar.Plugins.PipeReader import Xmobar.Plugins.StdinReader import Xmobar.Plugins.MarqueePipeReader import Xmobar.Plugins.XMonadLog import Xmobar.Plugins.NotmuchMail import Xmobar.System.Signal(SignalType (..)) import Xmobar.App.Main(xmobar, xmobarMain, configFromArgs) import Xmobar.App.Config(defaultConfig) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/App/�������������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�013663� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/App/Compile.hs���������������������������������������������������������������0000644�0000000�0000000�00000016110�07346545000�015606� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Compile -- Copyright: (c) 2018 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Mon Nov 26, 2018 03:36 -- -- -- Utlities to compile xmobar executables on the fly -- ------------------------------------------------------------------------------ module Xmobar.App.Compile(recompile, trace, xmessage) where import Control.Monad.IO.Class import Control.Monad.Fix (fix) import Control.Exception.Extensible (try, bracket, SomeException(..)) import qualified Control.Exception.Extensible as E import Control.Monad (filterM, when) import Data.List ((\\)) import Data.Maybe (isJust) import System.FilePath((</>), takeExtension) import System.IO import System.Directory import System.Process import System.Exit import System.Posix.Process(executeFile, forkProcess, getAnyProcessStatus) import System.Posix.Types(ProcessID) import System.Posix.Signals isExecutable :: FilePath -> IO Bool isExecutable f = E.catch (executable <$> getPermissions f) (\(SomeException _) -> return False) checkBuildScript :: Bool -> FilePath -> IO Bool checkBuildScript verb buildscript = do exists <- doesFileExist buildscript if exists then do isExe <- isExecutable buildscript if isExe then do trace verb $ "Xmobar will use build script at " ++ show buildscript ++ " to recompile." return True else do trace verb $ unlines [ "Xmobar will not use build script, because " ++ show buildscript ++ " is not executable." , "Suggested resolution to use it: chmod u+x " ++ show buildscript ] return False else do trace verb $ "Xmobar will use ghc to recompile, because " ++ show buildscript ++ " does not exist." return False shouldRecompile :: Bool -> FilePath -> FilePath -> FilePath -> IO Bool shouldRecompile verb src bin lib = do libTs <- mapM getModTime . filter isSource =<< allFiles lib srcT <- getModTime src binT <- getModTime bin if any (binT <) (srcT : libTs) then do trace verb "Xmobar recompiling because some files have changed." return True else do trace verb $ "Xmobar skipping recompile because it is not forced " ++ "(e.g. via --recompile), and not any *.hs / *.lhs / *.hsc" ++ " files in lib/ have been changed." return False where isSource = flip elem [".hs",".lhs",".hsc"] . takeExtension allFiles t = do let prep = map (t</>) . Prelude.filter (`notElem` [".",".."]) cs <- prep <$> E.catch (getDirectoryContents t) (\(SomeException _) -> return []) ds <- filterM doesDirectoryExist cs concat . ((cs \\ ds):) <$> mapM allFiles ds getModTime f = E.catch (Just <$> getModificationTime f) (\(SomeException _) -> return Nothing) runProc :: FilePath -> [String] -> FilePath -> Handle -> IO ProcessHandle runProc bin args dir eh = runProcess bin args (Just dir) Nothing Nothing Nothing (Just eh) xmessage :: String -> IO System.Posix.Types.ProcessID xmessage msg = forkProcess $ executeFile "xmessage" True ["-default", "okay", replaceUnicode msg] Nothing where -- Replace some of the unicode symbols GHC uses in its output replaceUnicode = map $ \c -> case c of '\8226' -> '*' -- • '\8216' -> '`' -- ‘ '\8217' -> '`' -- ’ _ -> c ghcErrorMsg :: (Monad m, Show a) => String -> a -> String -> m String ghcErrorMsg src status ghcErr = return . unlines $ ["Error detected while loading xmobar configuration file: " ++ src] ++ lines (if null ghcErr then show status else ghcErr) ++ ["","Please check the file for errors."] -- | A 'trace' for the 'X' monad. Logs a string to stderr. The result may -- be found in your .xsession-errors file trace :: MonadIO m => Bool -> String -> m () trace verb msg = when verb (liftIO $ hPutStrLn stderr msg) -- | 'recompile force', recompile the xmobar configuration file when -- any of the following apply: -- -- * force is 'True' -- -- * the execName executable does not exist -- -- * the xmobar executable is older than .hs or any file in -- the @lib@ directory (under the configuration directory). -- -- The -i flag is used to restrict recompilation to the xmobar.hs file only, -- and any files in the aforementioned @lib@ directory. -- -- Compilation errors (if any) are logged to the @xmobar.errors@ file -- in the given directory. If GHC indicates failure with a -- non-zero exit code, an xmessage displaying that file is spawned. -- -- 'False' is returned if there are compilation errors. -- recompile :: MonadIO m => String -> String -> String -> Bool -> Bool -> m Bool recompile confDir dataDir execName force verb = liftIO $ do let bin = confDir </> execName err = dataDir </> (execName ++ ".errors") src = confDir </> (execName ++ ".hs") lib = confDir </> "lib" script = confDir </> "build" useScript <- checkBuildScript verb script sc <- if useScript || force then return True else shouldRecompile verb src bin lib if sc then do uninstallSignalHandlers status <- bracket (openFile err WriteMode) hClose $ \errHandle -> waitForProcess =<< if useScript then runScript script bin confDir errHandle else runGHC bin confDir errHandle installSignalHandlers if status == ExitSuccess then trace verb "Xmobar recompilation process exited with success!" else do msg <- readFile err >>= ghcErrorMsg src status hPutStrLn stderr msg exitWith (ExitFailure 1) return (status == ExitSuccess) else return True where opts bin = ["--make" , execName ++ ".hs" , "-i" , "-ilib" , "-fforce-recomp" , "-main-is", "main" , "-v0"] #ifdef THREADED_RUNTIME ++ ["-threaded"] #endif #ifdef RTSOPTS ++ ["-rtsopts", "-with-rtsopts", "-V0"] #endif ++ ["-o", bin] runGHC bin = runProc "ghc" (opts bin) runScript script bin = runProc script [bin] -- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to -- avoid zombie processes, and clean up any extant zombie processes. installSignalHandlers :: MonadIO m => m () installSignalHandlers = liftIO $ do installHandler openEndedPipe Ignore Nothing installHandler sigCHLD Ignore Nothing (try :: IO a -> IO (Either SomeException a)) $ fix $ \more -> do x <- getAnyProcessStatus False False when (isJust x) more return () uninstallSignalHandlers :: MonadIO m => m () uninstallSignalHandlers = liftIO $ do installHandler openEndedPipe Default Nothing installHandler sigCHLD Default Nothing return () ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/App/Config.hs����������������������������������������������������������������0000644�0000000�0000000�00000011553�07346545000�015431� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Config.Defaults -- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Nov 25, 2018 22:26 -- -- -- Default values for Xmobar configurations and functions to access -- configuration files and directories. -- ------------------------------------------------------------------------------ module Xmobar.App.Config (defaultConfig, xmobarDataDir, xmobarConfigFile) where import Control.Monad (when, filterM) import Data.Functor ((<&>)) import System.Environment import System.Directory import System.FilePath ((</>)) import System.Posix.Files (fileExist) import Xmobar.Plugins.Date import Xmobar.Plugins.StdinReader import Xmobar.Config.Types import Xmobar.Run.Runnable -- | The default configuration values defaultConfig :: Config defaultConfig = Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" , additionalFonts = [] , wmClass = "xmobar" , wmName = "xmobar" , bgColor = "#000000" , fgColor = "#BFBFBF" , alpha = 255 , position = Top , border = NoBorder , borderColor = "#BFBFBF" , borderWidth = 1 , textOffset = -1 , iconOffset = -1 , textOffsets = [] , hideOnStart = False , lowerOnStart = True , persistent = False , allDesktops = True , overrideRedirect = True , pickBroadest = False , iconRoot = "." , commands = [ Run $ Date "%a %b %_d %Y * %H:%M:%S" "theDate" 10 , Run StdinReader] , sepChar = "%" , alignSep = "}{" , template = "%StdinReader% }{ " ++ "<fc=#00FF00>%uname%</fc> * <fc=#FF0000>%theDate%</fc>" , verbose = False , signal = SignalChan Nothing , textOutput = False , textOutputFormat = Plain , dpi = 96.0 } -- | Return the path to the xmobar data directory. This directory is -- used by Xmobar to store data files such as the run-time state file -- and the configuration binary generated by GHC. -- -- Several directories are considered. In order of preference: -- -- 1. The directory specified in the @XMOBAR_DATA_DIR@ environment variable. -- 2. The @XDG_DATA_HOME/xmobar@ directory. -- 3. The @~\/.xmobar@ directory. -- -- The first directory that exists will be used. If none of the -- directories exist then (1) will be used if it is set, otherwise (2) -- will be used. Either way, a directory will be created if -- necessary. xmobarDataDir :: IO String xmobarDataDir = findFirstDirWithEnv True "XMOBAR_DATA_DIR" [ getXdgDirectory XdgData "xmobar" , getAppUserDataDirectory "xmobar" ] -- | Helper function that will find the first existing directory and -- return its path. If none of the directories can be found, -- optionally create and return the first from the list. If the list -- is empty this function returns the historical @~\/.xmobar@ -- directory. findFirstDirOf :: Bool -> [IO FilePath] -> IO FilePath findFirstDirOf create [] = findFirstDirOf create [getAppUserDataDirectory "xmobar"] findFirstDirOf create possibles = do found <- go possibles case found of Just path -> return path Nothing -> do primary <- head possibles when create (createDirectoryIfMissing True primary) return primary where go [] = return Nothing go (x:xs) = do exists <- x >>= doesDirectoryExist if exists then x <&> Just else go xs -- | Simple wrapper around @findFirstDirOf@ that allows the primary -- path to be specified by an environment variable. findFirstDirWithEnv :: Bool -> String -> [IO FilePath] -> IO FilePath findFirstDirWithEnv create envName paths = do envPath' <- lookupEnv envName case envPath' of Nothing -> findFirstDirOf create paths Just envPath -> findFirstDirOf create (return envPath:paths) xmobarInConfigDirs :: FilePath -> IO (Maybe FilePath) xmobarInConfigDirs fn = do env <- lookupEnv "XMOBAR_CONFIG_DIR" xdg <- getXdgDirectory XdgConfig "xmobar" app <- getAppUserDataDirectory "xmobar" hom <- getHomeDirectory let candidates = case env of Nothing -> [app, xdg, hom] Just p -> [p, app, xdg, hom] fs <- filterM (\d -> fileExist (d </> fn)) candidates return $ if null fs then Nothing else Just (head fs </> fn) xmobarConfigFile :: IO (Maybe FilePath) xmobarConfigFile = fmap ffirst $ mapM xmobarInConfigDirs ["xmobar.hs", ".xmobarrc", "xmobarrc"] where ffirst [] = Nothing ffirst (Nothing:fs) = ffirst fs ffirst (p:_) = p �����������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/App/Main.hs������������������������������������������������������������������0000644�0000000�0000000�00000005210�07346545000�015101� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Main -- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Nov 25, 2018 21:53 -- -- -- Support for creating executable main functions -- ------------------------------------------------------------------------------ module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where import Data.List (intercalate) import System.Posix.Process (executeFile) import System.Environment (getArgs) import System.FilePath ((</>), takeBaseName, takeDirectory, takeExtension) import Text.Parsec.Error (ParseError) import Control.Monad (unless) import Xmobar.App.Config import Xmobar.Config.Types import Xmobar.Config.Parse import Xmobar.X11.Loop (x11Loop) import Xmobar.Text.Loop (textLoop) import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts) import Xmobar.App.Compile (recompile, trace) xmobar :: Config -> IO () xmobar cfg = if textOutput cfg then textLoop cfg else x11Loop cfg configFromArgs :: Config -> IO Config configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst buildLaunch :: [String] -> Bool -> Bool -> String -> ParseError -> IO () buildLaunch args verb force p e = do let exec = takeBaseName p confDir = takeDirectory p ext = takeExtension p if ext `elem` [".hs", ".hsc", ".lhs"] then xmobarDataDir >>= \dd -> recompile confDir dd exec force verb >> executeFile (confDir </> exec) False args Nothing else trace True ("Invalid configuration file: " ++ show e) >> trace True "\n(No compilation attempted: \ \only .hs, .hsc or .lhs files are compiled)" xmobar' :: [String] -> Config -> IO () xmobar' defs cfg = do unless (null defs || not (verbose cfg)) $ putStrLn $ "Fields missing from config defaulted: " ++ intercalate "," defs xmobar cfg xmobarMain :: IO () xmobarMain = do args <- getArgs (flags, rest) <- getOpts args cf <- case rest of [c] -> return (Just c) [] -> xmobarConfigFile _ -> error $ "Too many arguments: " ++ show rest case cf of Nothing -> case rest of (c:_) -> error $ c ++ ": file not found" _ -> doOpts defaultConfig flags >>= xmobar Just p -> do r <- readConfig defaultConfig p case r of Left e -> buildLaunch (filter (/= p) args) (verboseFlag flags) (recompileFlag flags) p e Right (c, defs) -> doOpts c flags >>= xmobar' defs ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/App/Opts.hs������������������������������������������������������������������0000644�0000000�0000000�00000016244�07346545000�015153� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Opts -- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Fri Nov 30, 2018 01:19 -- -- -- Command line option parsing -- ------------------------------------------------------------------------------ module Xmobar.App.Opts ( recompileFlag , verboseFlag , getOpts , doOpts) where import Control.Monad (when) import System.Console.GetOpt import System.Exit (exitSuccess, exitWith, ExitCode(..)) import Data.Version (showVersion) import Text.Read (readMaybe) import Paths_xmobar (version) import Xmobar.Config.Types data Opts = Help | Verbose | Recompile | Version | TextOutput (Maybe String) | Font String | AddFont String | BgColor String | FgColor String | Alpha String | T | B | D | AlignSep String | Commands String | AddCommand String | SepChar String | Template String | OnScr String | IconRoot String | Position String | WmClass String | WmName String | Dpi String deriving (Show, Eq) options :: [OptDescr Opts] options = [ Option "h?" ["help"] (NoArg Help) "This help" , Option "v" ["verbose"] (NoArg Verbose) "Emit verbose debugging messages" , Option "r" ["recompile"] (NoArg Recompile) "Force recompilation" , Option "V" ["version"] (NoArg Version) "Show version information" , Option "T" ["text"] (OptArg TextOutput "color") "Write text-only output to stdout. Plain/Ansi/Pango/Swaybar" , Option "f" ["font"] (ReqArg Font "font name") "Font name" , Option "N" ["add-font"] (ReqArg AddFont "font name") "Add to the list of additional fonts" , Option "w" ["wmclass"] (ReqArg WmClass "class") "X11 WM_CLASS property" , Option "n" ["wmname"] (ReqArg WmName "name") "X11 WM_NAME property" , Option "B" ["bgcolor"] (ReqArg BgColor "bg color" ) "The background color. Default black" , Option "F" ["fgcolor"] (ReqArg FgColor "fg color") "The foreground color. Default grey" , Option "i" ["iconroot"] (ReqArg IconRoot "path") "Root directory for icon pattern paths. Default '.'" , Option "A" ["alpha"] (ReqArg Alpha "alpha") "Transparency: 0 is transparent, 255 is opaque. Default: 255" , Option "o" ["top"] (NoArg T) "Place xmobar at the top of the screen" , Option "b" ["bottom"] (NoArg B) "Place xmobar at the bottom of the screen" , Option "d" ["dock"] (NoArg D) "Don't override redirect from WM and function as a dock" , Option "a" ["alignsep"] (ReqArg AlignSep "alignsep") "Separators for left, center and right text\nalignment. Default: '}{'" , Option "s" ["sepchar"] (ReqArg SepChar "char") ("Character used to separate commands in" ++ "\nthe output template. Default '%'") , Option "t" ["template"] (ReqArg Template "template") "Output template" , Option "c" ["commands"] (ReqArg Commands "commands") "List of commands to be executed" , Option "C" ["add-command"] (ReqArg AddCommand "command") "Add to the list of commands to be executed" , Option "x" ["screen"] (ReqArg OnScr "screen") "On which X screen number to start" , Option "p" ["position"] (ReqArg Position "position") "Specify position of xmobar. Same syntax as in config file" , Option "D" ["dpi"] (ReqArg Dpi "dpi") "The DPI scaling factor. Default 96.0" ] getOpts :: [String] -> IO ([Opts], [String]) getOpts argv = do (o,n) <- case getOpt Permute options argv of (o,n,[]) -> return (o,n) (_,_,errs) -> error (concat errs ++ usage) when (Help `elem` o) (putStr usage >> exitSuccess) when (Version `elem` o) (putStr info >> exitSuccess) return (o, n) usage :: String usage = usageInfo header options ++ footer where header = "Usage: xmobar [OPTION...] [FILE]\nOptions:" footer = "\nMail bug reports and suggestions to " ++ mail ++ "\n" info :: String info = "xmobar " ++ showVersion version ++ "\n (C) 2010 - 2022 Jose A Ortega Ruiz" ++ "\n (C) 2007 - 2010 Andrea Rossato\n " ++ mail ++ "\n" ++ license ++ "\n" mail :: String mail = "<mail@jao.io>" license :: String license = "\nThis program is distributed in the hope that it will be useful," ++ "\nbut WITHOUT ANY WARRANTY; without even the implied warranty of" ++ "\nMERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE." ++ "\nSee the License for more details." doOpts :: Config -> [Opts] -> IO Config doOpts conf [] = return (conf {lowerOnStart = lowerOnStart conf && overrideRedirect conf}) doOpts conf (o:oo) = case o of Help -> doOpts' conf Version -> doOpts' conf Recompile -> doOpts' conf TextOutput s -> doOpts' $ case s of Just fmt -> conf {textOutput = True, textOutputFormat = read fmt} Nothing -> conf {textOutput = True} Verbose -> doOpts' (conf {verbose = True}) Font s -> doOpts' (conf {font = s}) AddFont s -> doOpts' (conf {additionalFonts = additionalFonts conf ++ [s]}) WmClass s -> doOpts' (conf {wmClass = s}) WmName s -> doOpts' (conf {wmName = s}) BgColor s -> doOpts' (conf {bgColor = s}) FgColor s -> doOpts' (conf {fgColor = s}) Alpha n -> doOpts' (conf {alpha = read n}) T -> doOpts' (conf {position = Top}) B -> doOpts' (conf {position = Bottom}) D -> doOpts' (conf {overrideRedirect = False}) AlignSep s -> doOpts' (conf {alignSep = s}) SepChar s -> doOpts' (conf {sepChar = s}) Template s -> doOpts' (conf {template = s}) IconRoot s -> doOpts' (conf {iconRoot = s}) OnScr n -> doOpts' (conf {position = OnScreen (read n) $ position conf}) Commands s -> case readCom 'c' s of Right x -> doOpts' (conf {commands = x}) Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) AddCommand s -> case readCom 'C' s of Right x -> doOpts' (conf {commands = commands conf ++ x}) Left e -> putStr (e ++ usage) >> exitWith (ExitFailure 1) Position s -> readPosition s Dpi d -> doOpts' (conf {dpi = read d}) where readCom c str = case readStr str of [x] -> Right x _ -> Left ("xmobar: cannot read list of commands " ++ "specified with the -" ++ c:" option\n") readStr str = [x | (x,t) <- reads str, ("","") <- lex t] doOpts' c = doOpts c oo readPosition string = case readMaybe string of Just x -> doOpts' (conf { position = x }) Nothing -> do putStrLn "Can't parse position option, ignoring" doOpts' conf recompileFlag :: [Opts] -> Bool recompileFlag = elem Recompile verboseFlag :: [Opts] -> Bool verboseFlag = elem Verbose ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Config/����������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�014350� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Config/Parse.hs��������������������������������������������������������������0000644�0000000�0000000�00000017460�07346545000�015766� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE FlexibleContexts, CPP #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Config.Parse -- Copyright: (c) 2018, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Nov 25, 2018 23:56 -- -- -- Parsing of configuration files -- ------------------------------------------------------------------------------ module Xmobar.Config.Parse(readConfig , parseConfig , indexedFont , indexedOffset , colorComponents) where import Text.ParserCombinators.Parsec import Text.ParserCombinators.Parsec.Number (int) import Text.ParserCombinators.Parsec.Perm ((<|?>), (<$?>), permute) import Control.Monad.IO.Class (liftIO) import Data.Functor ((<&>)) import Xmobar.Config.Types import qualified System.IO as S (readFile) -- | Splits a colors string into its two components colorComponents :: Config -> String -> (String, String) colorComponents conf c = case break (==',') c of (f,',':b) -> (f, b) (f, _) -> (f, bgColor conf) stripComments :: String -> String stripComments = unlines . map (drop 5 . strip False . (replicate 5 ' '++)) . lines where strip m ('-':'-':xs) = if m then "--" ++ strip m xs else "" strip m ('"':xs) = '"': strip (not m) xs strip m (x:xs) = x : strip m xs strip _ [] = [] -- | Parse the config, logging a list of fields that were missing and replaced -- by the default definition. parseConfig :: Config -> String -> Either ParseError (Config,[String]) parseConfig defaultConfig = runParser parseConf fields "Config" . stripComments where parseConf = do many space sepEndSpc ["Config","{"] x <- perms eof s <- getState return (x, s) perms = permute $ Config <$?> pFont <|?> pFontList <|?> pWmClass <|?> pWmName <|?> pBgColor <|?> pFgColor <|?> pPosition <|?> pTextOutput <|?> pTextOutputFormat <|?> pTextOffset <|?> pTextOffsets <|?> pIconOffset <|?> pBorder <|?> pBdColor <|?> pBdWidth <|?> pAlpha <|?> pHideOnStart <|?> pAllDesktops <|?> pOverrideRedirect <|?> pPickBroadest <|?> pLowerOnStart <|?> pPersistent <|?> pIconRoot <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate <|?> pVerbose <|?> pSignal <|?> pDpi fields = [ "font", "additionalFonts", "bgColor", "fgColor" , "wmClass", "wmName", "sepChar" , "alignSep" , "border", "borderColor" ,"template" , "position" , "textOffset", "textOffsets", "iconOffset" , "allDesktops", "overrideRedirect", "pickBroadest" , "hideOnStart", "lowerOnStart", "persistent", "iconRoot" , "alpha", "commands", "verbose", "signal", "textOutput" , "textOutputFormat", "dpi" ] pTextOutput = readField textOutput "textOutput" pTextOutputFormat = readField textOutputFormat "textOutputFormat" pFont = strField font "font" pFontList = strListField additionalFonts "additionalFonts" pWmClass = strField wmClass "wmClass" pWmName = strField wmName "wmName" pBgColor = strField bgColor "bgColor" pFgColor = strField fgColor "fgColor" pBdColor = strField borderColor "borderColor" pSepChar = strField sepChar "sepChar" pAlignSep = strField alignSep "alignSep" pTemplate = strField template "template" pTextOffset = readField textOffset "textOffset" pTextOffsets = readIntList textOffsets "textOffsets" pIconOffset = readField iconOffset "iconOffset" pPosition = readField position "position" pHideOnStart = readField hideOnStart "hideOnStart" pLowerOnStart = readField lowerOnStart "lowerOnStart" pPersistent = readField persistent "persistent" pBorder = readField border "border" pBdWidth = readField borderWidth "borderWidth" pAllDesktops = readField allDesktops "allDesktops" pOverrideRedirect = readField overrideRedirect "overrideRedirect" pPickBroadest = readField pickBroadest "pickBroadest" pIconRoot = readField iconRoot "iconRoot" pAlpha = readField alpha "alpha" pVerbose = readField verbose "verbose" pDpi = readField dpi "dpi" pSignal = field signal "signal" $ fail "signal is meant for use with Xmobar as a library.\n It is not meant for use in the configuration file." pCommands = field commands "commands" readCommands staticPos = do string "Static" wrapSkip (string "{") p <- many (noneOf "}") wrapSkip (string "}") string "," return ("Static {" ++ p ++ "}") tillFieldEnd = staticPos <|> many (noneOf ",}\n\r") commandsEnd = wrapSkip (string "]") >> (string "}" <|> notNextRun) notNextRun = do {string "," ; notFollowedBy $ wrapSkip $ string "Run" ; return "," } readCommands = manyTill anyChar (try commandsEnd) >>= read' commandsErr . flip (++) "]" strField e n = field e n strMulti strMulti = scan '"' where scan lead = do spaces char lead s <- manyTill anyChar (rowCont <|> unescQuote) (char '"' >> return s) <|> fmap (s ++) (scan '\\') rowCont = try $ char '\\' >> string "\n" unescQuote = lookAhead (noneOf "\\") >> lookAhead (string "\"") strListField e n = field e n strList strList = do spaces char '[' list <- sepBy (strMulti >>= \x -> spaces >> return x) (char ',') spaces char ']' return list wrapSkip x = many space >> x >>= \r -> many space >> return r sepEndSpc = mapM_ (wrapSkip . try . string) fieldEnd = many $ space <|> oneOf ",}" field e n c = (,) (e defaultConfig) $ updateState (filter (/= n)) >> sepEndSpc [n,"="] >> wrapSkip c >>= \r -> fieldEnd >> return r readField a n = field a n $ tillFieldEnd >>= read' n readIntList d n = field d n intList intList = do spaces char '[' list <- sepBy (spaces >> int >>= \x-> spaces >> return x) (char ',') spaces char ']' return list read' d s = case reads s of [(x, _)] -> return x _ -> fail $ "error reading the " ++ d ++ " field: " ++ s commandsErr :: String commandsErr = "commands: this usually means that a command could not" ++ "\nbe parsed." ++ "\nThe error could be located at the begining of the command" ++ "\nwhich follows the offending one." -- | Reads the configuration from a file or an error if it cannot be -- parsed. readConfig :: Config -> FilePath -> IO (Either ParseError (Config,[String])) readConfig defaultConfig f = liftIO (S.readFile f) <&> parseConfig defaultConfig -- | Extracts from a configuration the additional font at the corresponding index. -- Returns the default font if not present. indexedFont :: Config -> FontIndex -> String indexedFont config idx = if idx < 1 || idx > length (additionalFonts config) then font config else additionalFonts config !! (idx - 1) -- | Extracts from a configuration the offset at the corresponding index. -- Returns the default offset if not present. indexedOffset :: Config -> FontIndex -> Int indexedOffset config idx = if idx < 1 || idx > length (textOffsets config) then textOffset config else textOffsets config !! (idx - 1) ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Config/Template.hs�����������������������������������������������������������0000644�0000000�0000000�00000015465�07346545000�016472� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Config.Template -- Copyright: (c) 2022 jao -- License: BSD3-style (see LICENSE) -- -- Maintainer: mail@jao.io -- Stability: unstable -- Portability: portable -- Created: Fri Sep 30, 2022 06:33 -- -- -- Parsing template strings -- ------------------------------------------------------------------------------ module Xmobar.Config.Template (parseString) where import Data.Maybe (fromMaybe) import qualified Control.Monad as CM import Text.Parsec ((<|>)) import Text.Read (readMaybe) import qualified Text.Parsec as P import qualified Text.Parsec.Combinator as C import Text.ParserCombinators.Parsec (Parser) import qualified Xmobar.Config.Types as T type Context = (T.TextRenderInfo, T.FontIndex, Maybe [T.Action]) retSegment :: Context -> T.Widget -> Parser [T.Segment] retSegment (i, idx, as) widget = return [(widget, i, idx, as)] -- | Run the template string parser for the given config, producing a list of -- drawable segment specifications. parseString :: T.Config -> String -> [T.Segment] parseString c s = case P.parse (stringParser ci) "" s of Left _ -> [(T.Text $ "Could not parse string: " ++ s, ti, 0, Nothing)] Right x -> concat x where ci = (ti , 0, Nothing) ti = T.TextRenderInfo (T.fgColor c) 0 0 [] -- Top level parser reading the full template string stringParser :: Context -> Parser [[T.Segment]] stringParser c = C.manyTill (allParsers c) C.eof allParsers :: Context -> Parser [T.Segment] allParsers c = C.choice (textParser c:map (\f -> P.try (f c)) parsers) where parsers = [ iconParser, hspaceParser, rawParser, actionParser , fontParser, boxParser, colorParser ] -- Wrapper for notFollowedBy that returns the result of the first parser. -- Also works around the issue that, at least in Parsec 3.0.0, notFollowedBy -- accepts only parsers with return type Char. notFollowedBy' :: Parser a -> Parser b -> Parser a notFollowedBy' p e = do x <- p C.notFollowedBy $ P.try (e >> return '*') return x -- Parse a maximal string without markup textParser :: Context -> Parser [T.Segment] textParser c = C.many1 (P.noneOf "<" <|> P.try (notFollowedBy' (P.char '<') suffixes)) >>= retSegment c . T.Text where suffixes = C.choice $ map (P.try . P.string) [ "icon=" , "hspace=", "raw=" , "action=", "/action>", "fn=", "/fn>" , "box", "/box>", "fc=", "/fc>" ] -- Parse a "raw" tag, which we use to prevent other tags from creeping in. -- The format here is net-string-esque: a literal "<raw=" followed by a string -- of digits (base 10) denoting the length of the raw string, a literal ":" as -- digit-string-terminator, the raw string itself, and then a literal "/>". rawParser :: Context -> Parser [T.Segment] rawParser c = do P.string "<raw=" lenstr <- C.many1 P.digit P.char ':' case reads lenstr of [(len,[])] -> do CM.guard ((len :: Integer) <= fromIntegral (maxBound :: Int)) s <- C.count (fromIntegral len) P.anyChar P.string "/>" retSegment c (T.Text s) _ -> CM.mzero iconParser :: Context -> Parser [T.Segment] iconParser c = do P.string "<icon=" i <- C.manyTill (P.noneOf ">") (P.try (P.string "/>")) retSegment c (T.Icon i) hspaceParser :: Context -> Parser [T.Segment] hspaceParser c = do P.string "<hspace=" pVal <- C.manyTill P.digit (P.try (P.string "/>")) retSegment c (T.Hspace (fromMaybe 0 $ readMaybe pVal)) actionParser :: Context -> Parser [T.Segment] actionParser (ti, fi, act) = do P.string "<action=" command <- C.between (P.char '`') (P.char '`') (C.many1 (P.noneOf "`")) <|> C.many1 (P.noneOf ">") buttons <- (P.char '>' >> return "1") <|> (P.space >> P.spaces >> C.between (P.string "button=") (P.string ">") (C.many1 (P.oneOf "12345"))) let a = T.Spawn (toButtons buttons) command a' = case act of Nothing -> Just [a] Just act' -> Just $ a : act' s <- C.manyTill (allParsers (ti, fi, a')) (P.try $ P.string "</action>") return (concat s) toButtons :: String -> [T.Button] toButtons = map (\x -> read [x]) colorParser :: Context -> Parser [T.Segment] colorParser (T.TextRenderInfo _ _ _ bs, fidx, a) = do c <- C.between (P.string "<fc=") (P.string ">") (C.many1 colorc) let colorParts = break (==':') c let (ot,ob) = case break (==',') (drop 1 $ snd colorParts) of (top,',':btm) -> (top, btm) (top, _) -> (top, top) tri = T.TextRenderInfo (fst colorParts) (fromMaybe (-1) $ readMaybe ot) (fromMaybe (-1) $ readMaybe ob) bs s <- C.manyTill (allParsers (tri, fidx, a)) (P.try $ P.string "</fc>") return (concat s) where colorc = P.alphaNum <|> P.oneOf ",:#" boxParser :: Context -> Parser [T.Segment] boxParser (T.TextRenderInfo cs ot ob bs, f, a) = do c <- C.between (P.string "<box") (P.string ">") (C.option "" (C.many1 (P.alphaNum <|> P.oneOf "= #,"))) let b = T.Box T.BBFull (T.BoxOffset T.C 0) 1 cs (T.BoxMargins 0 0 0 0) let g = boxReader b (words c) s <- C.manyTill (allParsers (T.TextRenderInfo cs ot ob (g : bs), f, a)) (P.try $ P.string "</box>") return (concat s) boxReader :: T.Box -> [String] -> T.Box boxReader b [] = b boxReader b (x:xs) = boxReader (boxParamReader b param val) xs where (param,val) = case break (=='=') x of (p,'=':v) -> (p, v) (p, _) -> (p, "") boxParamReader :: T.Box -> String -> String -> T.Box boxParamReader b _ "" = b boxParamReader (T.Box bb off lw fc mgs) "type" val = T.Box (fromMaybe bb $ readMaybe ("BB" ++ val)) off lw fc mgs boxParamReader (T.Box bb (T.BoxOffset alg off) lw fc mgs) "offset" (a:o) = T.Box bb (T.BoxOffset align offset) lw fc mgs where offset = fromMaybe off $ readMaybe o align = fromMaybe alg $ readMaybe [a] boxParamReader (T.Box bb off lw fc mgs) "width" val = T.Box bb off (fromMaybe lw $ readMaybe val) fc mgs boxParamReader (T.Box bb off lw _ mgs) "color" val = T.Box bb off lw val mgs boxParamReader (T.Box bb off lw fc mgs@(T.BoxMargins mt mr mb ml)) ('m':pos) v = let mgs' = case pos of "t" -> T.BoxMargins (maybeVal mt) mr mb ml "r" -> T.BoxMargins mt (maybeVal mr) mb ml "b" -> T.BoxMargins mt mr (maybeVal mb) ml "l" -> T.BoxMargins mt mr mb (maybeVal ml) _ -> mgs maybeVal d = fromMaybe d (readMaybe v) in T.Box bb off lw fc mgs' boxParamReader b _ _ = b fontParser :: Context -> Parser [T.Segment] fontParser (i, _, a) = do f <- C.between (P.string "<fn=") (P.string ">") (C.many1 P.digit) s <- C.manyTill (allParsers (i, fromMaybe 0 $ readMaybe f, a)) (P.try $ P.string "</fn>") return (concat s) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Config/Types.hs��������������������������������������������������������������0000644�0000000�0000000�00000022647�07346545000�016023� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Xmobar.Config.Types -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- The configuration types -- ----------------------------------------------------------------------------- module Xmobar.Config.Types ( Config (..) , XPosition (..), Align (..), Border (..), TextOutputFormat (..) , Segment , FontIndex , Box(..) , BoxBorder(..) , BoxOffset(..) , BoxMargins(..) , TextRenderInfo(..) , Widget(..) , SignalChan (..) , Action (..) , Button ) where import qualified Control.Concurrent.STM as STM import qualified Xmobar.Run.Runnable as R import qualified Xmobar.System.Signal as S import Data.Int (Int32) import Foreign.C.Types (CInt) import Xmobar.Run.Actions (Action (..), Button) -- $config -- Configuration data type -- | The configuration data type data Config = Config { font :: String -- ^ Font , additionalFonts :: [String] -- ^ List of alternative fonts , wmClass :: String -- ^ X11 WM_CLASS property value , wmName :: String -- ^ X11 WM_NAME property value , bgColor :: String -- ^ Backgroud color , fgColor :: String -- ^ Default font color , position :: XPosition -- ^ Top Bottom or Static , textOutput :: Bool -- ^ Write data to stdout instead of X , textOutputFormat :: TextOutputFormat -- ^ Which color format to use for stdout: Ansi or Pango , textOffset :: Int -- ^ Offset from top of window for text , textOffsets :: [Int] -- ^ List of offsets for additionalFonts , iconOffset :: Int -- ^ Offset from top of window for icons , border :: Border -- ^ NoBorder TopB BottomB or FullB , borderColor :: String -- ^ Border color , borderWidth :: Int -- ^ Border width , alpha :: Int -- ^ Transparency from 0 (transparent) -- to 255 (opaque) , hideOnStart :: Bool -- ^ Hide (Unmap) the window on -- initialization , allDesktops :: Bool -- ^ Tell the WM to map to all desktops , overrideRedirect :: Bool -- ^ Needed for dock behaviour in some -- non-tiling WMs , pickBroadest :: Bool -- ^ Use the broadest display -- instead of the first one by -- default , lowerOnStart :: Bool -- ^ lower to the bottom of the -- window stack on initialization , persistent :: Bool -- ^ Whether automatic hiding should -- be enabled or disabled , iconRoot :: FilePath -- ^ Root folder for icons , commands :: [R.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 -- commands in the output template -- (default '%') , alignSep :: String -- ^ Separators for left, center and -- right text alignment , template :: String -- ^ The output template , verbose :: Bool -- ^ Emit additional debug messages , signal :: SignalChan -- ^ Channel to send signals to xmobar , dpi :: Double -- ^ DPI scaling factor for fonts } deriving (Read, Show) -- | The position datatype data XPosition = Top -- ^ Top of the screen, full width, auto height | TopH -- ^ Top of the screen, full width with -- specific height Int -- ^ Height (in pixels) -- | Top of the screen, full width with -- specific height and margins | TopHM Int -- ^ Height (in pixels) Int -- ^ Left margin (in pixels) Int -- ^ Right margin (in pixels) Int -- ^ Top margin (in pixels) Int -- ^ Bottom margin (in pixels) -- | Top of the screen with specific width -- (as screen percentage) and alignment | TopW Align -- ^ Alignement (L|C|R) Int -- ^ Width as screen percentage (0-100) -- | Top of the screen with specific width -- (as screen percentage), height and -- alignment | TopSize Align -- ^ Alignement (L|C|R) Int -- ^ Width as screen percentage (0-100) Int -- ^ Height (in pixels) -- | Top of the screen with specific left/right -- margins | TopP Int -- ^ Left margin (in pixels) Int -- ^ Right margin (in pixels) -- | Bottom of the screen, full width, auto height | Bottom | BottomH -- ^ Bottom of the screen, full width, with -- specific height Int -- ^ Height (in pixels) -- | Bottom of the screen with specific height -- and margins | BottomHM Int -- ^ Height (in pixels) Int -- ^ Left margin (in pixels) Int -- ^ Right margin (in pixels) Int -- ^ Top margin (in pixels) Int -- ^ Bottom margin (in pixels) -- | Bottom of the screen with specific -- left/right margins | BottomP Int -- ^ Left margin (in pixels) Int -- ^ Bottom margin (in pixels) -- | Bottom of the screen with specific width -- (as screen percentage) and alignment -- and alignment | BottomW Align -- ^ Alignement (L|C|R) Int -- ^ Width as screen percentage (0-100) -- | Bottom of the screen with specific width -- (as screen percentage), height -- and alignment | BottomSize Align -- ^ Alignement (L|C|R) Int -- ^ Width as screen percentage (0-100) Int -- ^ Height (in pixels) -- | Static position and specific size | Static { xpos :: Int -- ^ Position X (in pixels) , ypos :: Int -- ^ Position Y (in pixels) , width :: Int -- ^ Width (in pixels) , height :: Int -- ^ Height (in pixels) } -- | Along with the position characteristics -- specify the screen to display the bar | OnScreen Int -- ^ Screen id (primary is 0) XPosition -- ^ Position deriving ( Read, Show, Eq ) data Align = L | R | C deriving ( Read, Show, Eq ) data Border = NoBorder | TopB | BottomB | FullB | TopBM Int | BottomBM Int | FullBM Int deriving ( Read, Show, Eq ) data TextOutputFormat = Plain | Ansi | Pango | Swaybar deriving (Read, Show, Eq) type FontIndex = Int newtype SignalChan = SignalChan {unSignalChan :: Maybe (STM.TMVar S.SignalType)} instance Read SignalChan where readsPrec _ _ = fail "SignalChan is not readable from a String" instance Show SignalChan where show (SignalChan (Just _)) = "SignalChan (Just <tmvar>)" show (SignalChan Nothing) = "SignalChan Nothing" data Widget = Icon String | Text String | Hspace Int32 deriving Show data BoxOffset = BoxOffset Align Int32 deriving (Eq, Show) -- margins: Top, Right, Bottom, Left data BoxMargins = BoxMargins Int32 Int32 Int32 Int32 deriving (Eq, Show) data BoxBorder = BBTop | BBBottom | BBVBoth | BBLeft | BBRight | BBHBoth | BBFull deriving (Read, Eq, Show) data Box = Box { bBorder :: BoxBorder , bOffset :: BoxOffset , bWidth :: CInt , bColor :: String , bMargins :: BoxMargins } deriving (Eq, Show) data TextRenderInfo = TextRenderInfo { tColorsString :: String , tBgTopOffset :: Int32 , tBgBottomOffset :: Int32 , tBoxes :: [Box] } deriving Show type Segment = (Widget, TextRenderInfo, FontIndex, Maybe [Action]) �����������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Draw/������������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�014040� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Draw/Boxes.hs����������������������������������������������������������������0000644�0000000�0000000�00000004412�07346545000�015455� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Boxes -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: unportable -- Start date: Fri Sep 16, 2022 04:01 -- -- Borders and boxes -- ------------------------------------------------------------------------------ module Xmobar.Draw.Boxes (Line, boxLines, BoxRect, borderRect) where import qualified Xmobar.Config.Types as T type Line = (Double, Double, Double, Double) type BoxRect = (Double, Double, Double, Double) -- | Computes the coordinates of a list of lines representing a Box. -- The Box is to be positioned between x0 and x1, with height ht, and drawn -- with line width lw. The returned lists are coordinates of the beginning -- and end of each line. boxLines :: T.Box -> Double -> Double -> Double -> [Line] boxLines (T.Box bd offset lw _ margins) ht x0 x1 = case bd of T.BBTop -> [rtop] T.BBBottom -> [rbot] T.BBVBoth -> [rtop, rbot] T.BBLeft -> [rleft] T.BBRight -> [rright] T.BBHBoth -> [rleft, rright] T.BBFull -> [rtop, rbot, rleft, rright] where (T.BoxMargins top right bot left) = margins (T.BoxOffset align m) = offset ma = fromIntegral m (p0, p1) = case align of T.L -> (0, -ma) T.C -> (ma, -ma) T.R -> (ma, 0) lc = fromIntegral lw / 2 [mt, mr, mb, ml] = map fromIntegral [top, right, bot, left] xmin = x0 - ml - lc xmax = x1 + mr + lc ymin = mt + lc ymax = ht - mb - lc rtop = (xmin + p0, ymin, xmax + p1, ymin) rbot = (xmin + p0, ymax, xmax + p1, ymax) rleft = (xmin, ymin + p0, xmin, ymax + p1) rright = (xmax, ymin + p0, xmax, ymax + p1) -- | Computes the rectangle (x, y, width, height) for the given Border. borderRect :: T.Border -> Double -> Double -> BoxRect borderRect bdr w h = case bdr of T.TopB -> (0, 0, w - 1, 0) T.BottomB -> (0, h - 1, w - 1, 0) T.FullB -> (0, 0, w - 1, h - 1) T.TopBM m -> (0, fi m, w - 1, 0) T.BottomBM m -> (0, h - fi m, w - 1, 0) T.FullBM m -> (fi m, fi m, w - 2 * fi m, h - 2 * fi m) T.NoBorder -> (-1, -1, -1, -1) where fi = fromIntegral ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Draw/Cairo.hs����������������������������������������������������������������0000644�0000000�0000000�00000016665�07346545000�015447� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Cairo -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: unportable -- Created: Fri Sep 09, 2022 02:03 -- -- Drawing the xmobar contents using Cairo and Pango -- -- ------------------------------------------------------------------------------ module Xmobar.Draw.Cairo (drawSegments) where import qualified Data.Colour.SRGB as SRGB import qualified Data.Colour.Names as CNames import Control.Monad (foldM, when) import qualified Graphics.Rendering.Cairo as Cairo import qualified Graphics.Rendering.Pango as Pango import Graphics.Rendering.Cairo.Types(Surface) import qualified Xmobar.Config.Types as C import qualified Xmobar.Config.Parse as ConfigParse import qualified Xmobar.Text.Pango as TextPango import qualified Xmobar.Draw.Boxes as Boxes import qualified Xmobar.Draw.Types as T type Renderinfo = (C.Segment, Surface -> Double -> Double -> IO (), Double) type BoundedBox = (Double, Double, [C.Box]) type Acc = (Double, T.Actions, [BoundedBox]) readColourName :: String -> (SRGB.Colour Double, Double) readColourName str = case CNames.readColourName str of Just c -> (c, 1.0) Nothing -> case SRGB.sRGB24reads str of [(c, "")] -> (c, 1.0) [(c,d)] -> (c, read ("0x" ++ d)) _ -> (CNames.white, 1.0) setSourceColor :: (SRGB.Colour Double, Double) -> Cairo.Render () setSourceColor (colour, alph) = if alph < 1 then Cairo.setSourceRGBA r g b alph else Cairo.setSourceRGB r g b where rgb = SRGB.toSRGB colour r = SRGB.channelRed rgb g = SRGB.channelGreen rgb b = SRGB.channelBlue rgb renderLines :: String -> Double -> [Boxes.Line] -> Cairo.Render () renderLines color wd lns = do setSourceColor (readColourName color) Cairo.setLineWidth wd mapM_ (\(x0, y0, x1, y1) -> Cairo.moveTo x0 y0 >> Cairo.lineTo x1 y1 >> Cairo.stroke) lns segmentMarkup :: C.Config -> C.Segment -> String segmentMarkup conf (C.Text txt, info, idx, _actions) = let fnt = TextPango.fixXft $ ConfigParse.indexedFont conf idx (fg, bg) = ConfigParse.colorComponents conf (C.tColorsString info) attrs = [Pango.FontDescr fnt, Pango.FontForeground fg] attrs' = if bg == C.bgColor conf then attrs else Pango.FontBackground bg:attrs in Pango.markSpan attrs' $ Pango.escapeMarkup txt segmentMarkup _ _ = "" withRenderinfo :: Pango.PangoContext -> T.DrawContext -> C.Segment -> IO Renderinfo withRenderinfo ctx dctx seg@(C.Text _, inf, idx, a) = do let conf = T.dcConfig dctx lyt <- Pango.layoutEmpty ctx mk <- Pango.layoutSetMarkup lyt (segmentMarkup conf seg) :: IO String (_, Pango.PangoRectangle o u w h) <- Pango.layoutGetExtents lyt let voff' = fromIntegral $ ConfigParse.indexedOffset conf idx voff = voff' + (T.dcHeight dctx - h + u) / 2.0 wd = w - o slyt s off mx = do when (off + w > mx) $ do Pango.layoutSetEllipsize lyt Pango.EllipsizeEnd Pango.layoutSetWidth lyt (Just $ mx - off) Cairo.renderWith s $ Cairo.moveTo off voff >> Pango.showLayout lyt return ((C.Text mk, inf, idx, a), slyt, wd) withRenderinfo _ _ seg@(C.Hspace w, _, _, _) = return (seg, \_ _ _ -> return (), fromIntegral w) withRenderinfo _ dctx seg@(C.Icon p, info, _, _) = do let (wd, _) = T.dcIconLookup dctx p ioff = C.iconOffset (T.dcConfig dctx) vpos = T.dcHeight dctx / 2 + fromIntegral ioff conf = T.dcConfig dctx (fg, bg) = ConfigParse.colorComponents conf (C.tColorsString info) render _ off mx = when (off + wd <= mx) $ T.dcIconDrawer dctx off vpos p fg bg return (seg, render, wd) drawBox :: T.DrawContext -> Surface -> Double -> Double -> C.Box -> IO () drawBox dctx surf x0 x1 box@(C.Box _ _ w color _) = Cairo.renderWith surf $ renderLines color (fromIntegral w) (Boxes.boxLines box (T.dcHeight dctx) x0 x1) drawSegmentBackground :: T.DrawContext -> Surface -> C.TextRenderInfo -> Double -> Double -> IO () drawSegmentBackground dctx surf info x0 x1 = when (bg /= C.bgColor conf && (top >= 0 || bot >= 0)) $ Cairo.renderWith surf $ do setSourceColor (readColourName bg) Cairo.rectangle x0 top (x1 - x0) (T.dcHeight dctx - bot - top) Cairo.fillPreserve where conf = T.dcConfig dctx (_, bg) = ConfigParse.colorComponents conf (C.tColorsString info) top = fromIntegral $ C.tBgTopOffset info bot = fromIntegral $ C.tBgBottomOffset info drawSegment :: T.DrawContext -> Surface -> Double -> Acc -> Renderinfo -> IO Acc drawSegment dctx surface maxoff (off, acts, boxs) (segment, render, lwidth) = do let end = min maxoff (off + lwidth) (_, info, _, a) = segment acts' = case a of Just as -> (as, off, end):acts; _ -> acts bs = C.tBoxes info boxs' = if null bs then boxs else (off, end, bs):boxs when (end > off) $ do drawSegmentBackground dctx surface info off end render surface off maxoff return (off + lwidth, acts', boxs') renderOuterBorder :: C.Config -> Double -> Double -> Cairo.Render () renderOuterBorder conf mw mh = do let (x0, y0, w, h) = Boxes.borderRect (C.border conf) mw mh setSourceColor (readColourName (C.borderColor conf)) Cairo.setLineWidth (fromIntegral (C.borderWidth conf)) Cairo.rectangle x0 y0 w h Cairo.stroke drawBorder :: C.Config -> Double -> Double -> Surface -> IO () drawBorder conf w h surf = case C.border conf of C.NoBorder -> return () _ -> Cairo.renderWith surf (renderOuterBorder conf w h) drawBBox :: T.DrawContext -> Surface -> BoundedBox -> IO () drawBBox dctx surf (from, to, bs) = mapM_ (drawBox dctx surf from to) bs drawBoxes :: T.DrawContext -> Surface -> [BoundedBox] -> IO () drawBoxes dctx surf ((from, to, b):(from', to', b'):bxs) = if to < from' || b /= b' then do drawBBox dctx surf (from, to, b) drawBoxes dctx surf $ (from', to', b'):bxs else drawBoxes dctx surf $ (from, to', b'):bxs drawBoxes dctx surf [bi] = drawBBox dctx surf bi drawBoxes _ _ [] = return () #ifndef XRENDER drawCairoBackground :: T.DrawContext -> Surface -> IO () drawCairoBackground dctx surf = do let (c, _) = readColourName (C.bgColor (T.dcConfig dctx)) Cairo.renderWith surf $ setSourceColor (c, 1.0) >> Cairo.paint #endif drawSegments :: T.DrawContext -> Surface -> IO T.Actions drawSegments dctx surf = do let [left, center, right] = take 3 $ T.dcSegments dctx ++ repeat [] dh = T.dcHeight dctx dw = T.dcWidth dctx conf = T.dcConfig dctx sWidth = foldl (\a (_,_,w) -> a + w) 0 ctx <- Pango.cairoCreateContext Nothing Pango.cairoContextSetResolution ctx $ C.dpi conf llyts <- mapM (withRenderinfo ctx dctx) left rlyts <- mapM (withRenderinfo ctx dctx) right clyts <- mapM (withRenderinfo ctx dctx) center #ifndef XRENDER drawCairoBackground dctx surf #endif (lend, as, bx) <- foldM (drawSegment dctx surf dw) (0, [], []) llyts let [rw, cw] = map sWidth [rlyts, clyts] rstart = max lend (dw - rw) cstart = if lend > 1 then max lend ((dw - cw) / 2.0) else lend (_, as', bx') <- if cw > 0 then foldM (drawSegment dctx surf rstart) (cstart, as, bx) clyts else return (0, as, bx) (_, as'', bx'') <- foldM (drawSegment dctx surf dw) (rstart, as', bx') rlyts drawBoxes dctx surf (reverse bx'') when (C.borderWidth conf > 0) (drawBorder conf dw dh surf) return as'' ���������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Draw/Types.hs����������������������������������������������������������������0000644�0000000�0000000�00000002056�07346545000�015503� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Draw.Types -- Copyright: (c) 2022 jao -- License: BSD3-style (see LICENSE) -- -- Maintainer: mail@jao.io -- Stability: unstable -- Portability: portable -- Created: Tue Sep 20, 2022 04:49 -- -- -- Type definitions for describing drawing operations -- ------------------------------------------------------------------------------ module Xmobar.Draw.Types where import Xmobar.Config.Types (Config, Segment) import Xmobar.Run.Actions (Action) type Position = Double type ActionPos = ([Action], Position, Position) type Actions = [ActionPos] type IconLookup = String -> (Double, Double) type IconDrawer = Double -> Double -> String -> String -> String -> IO () data DrawContext = DC { dcIconDrawer :: IconDrawer , dcIconLookup :: IconLookup , dcConfig :: Config , dcWidth :: Double , dcHeight :: Double , dcSegments :: [[Segment]] } ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/���������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�014564� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/BufferedPipeReader.hs������������������������������������������������0000644�0000000�0000000�00000005535�07346545000�020613� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- 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 Xmobar.Plugins.BufferedPipeReader(BufferedPipeReader(..)) where import Control.Monad(forM_, when, void) import Control.Concurrent import Control.Concurrent.STM import System.IO import System.IO.Unsafe(unsafePerformIO) import Xmobar.Run.Exec import Xmobar.System.Signal import Xmobar.System.Environment data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)] deriving (Read, Show) {-# NOINLINE signal #-} 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 fp' <- expandEnv fp openFile fp' ReadWriteMode >>= hGetLine >>= \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 = void (forkIO f) 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 readTVarIO ts >>= maybe (return ()) cb �������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Command.hs�����������������������������������������������������������0000644�0000000�0000000�00000003354�07346545000�016503� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Command -- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Dec 02, 2018 05:29 -- -- -- The basic Command plugin -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Command where import Control.Exception (handle, SomeException(..)) import System.Process import System.Exit import System.IO (hClose, hGetLine) import Xmobar.Run.Exec data Command = Com Program Args Alias Rate | ComX Program Args String Alias Rate deriving (Show,Read,Eq) type Args = [String] type Program = String type Alias = String type Rate = Int instance Exec Command where alias (ComX p _ _ a _) = if p /= "" then (if a == "" then p else a) else "" alias (Com p a al r) = alias (ComX p a "" al r) start (Com p as al r) cb = start (ComX p as ("Could not execute command " ++ p) al r) cb start (ComX prog args msg _ r) cb = if r > 0 then go else exec where go = doEveryTenthSeconds r exec exec = do (i,o,e,p) <- runInteractiveProcess prog args Nothing Nothing exit <- waitForProcess p let closeHandles = hClose o >> hClose i >> hClose e getL = handle (\(SomeException _) -> return "") (hGetLine o) case exit of ExitSuccess -> do str <- getL closeHandles cb str _ -> closeHandles >> cb msg ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/CommandReader.hs�����������������������������������������������������0000644�0000000�0000000�00000002407�07346545000�017624� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.CommandReader -- Copyright : (c) John Goerzen -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A plugin for reading from external commands -- note: stderr is lost here -- ----------------------------------------------------------------------------- module Xmobar.Plugins.CommandReader(CommandReader(..)) where import System.IO import Xmobar.Run.Exec import System.Process(runInteractiveCommand, getProcessExitCode) data CommandReader = CommandReader String String deriving (Read, Show) instance Exec CommandReader where alias (CommandReader _ a) = a start (CommandReader p _) cb = do (hstdin, hstdout, hstderr, ph) <- runInteractiveCommand p hClose hstdin hClose hstderr hSetBinaryMode hstdout False hSetBuffering hstdout LineBuffering forever ph (hGetLine hstdout >>= cb) where forever ph a = do a ec <- getProcessExitCode ph case ec of Nothing -> forever ph a Just _ -> cb "EXITED" ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Date.hs��������������������������������������������������������������0000644�0000000�0000000�00000003023�07346545000�015773� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Date -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A date plugin for Xmobar -- -- Usage example: in template put -- -- > Run Date "%a %b %_d %Y <fc=#ee9a00> %H:%M:%S</fc>" "Mydate" 10 -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Date (Date(..), date) where import Xmobar.Run.Exec #if ! MIN_VERSION_time(1,5,0) import System.Locale #endif import Data.IORef import Data.Time import Control.Concurrent.Async (concurrently_) data Date = Date String String Int deriving (Read, Show) instance Exec Date where alias (Date _ a _) = a rate (Date _ _ r) = r start (Date f _ r) cb = -- refresh time zone once a minute to avoid wasting CPU cycles withRefreshingZone 600 $ \zone -> doEveryTenthSeconds r $ date zone f >>= cb date :: IORef TimeZone -> String -> IO String date zoneRef format = do zone <- readIORef zoneRef fmap (formatTime defaultTimeLocale format . utcToZonedTime zone) getCurrentTime withRefreshingZone :: Int -> (IORef TimeZone -> IO ()) -> IO () withRefreshingZone r action = do zone <- newIORef =<< getCurrentTimeZone let refresh = atomicWriteIORef zone =<< getCurrentTimeZone concurrently_ (doEveryTenthSeconds r refresh) (action zone) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/DateZone.hs����������������������������������������������������������0000644�0000000�0000000�00000005045�07346545000�016635� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} {-# LANGUAGE DoAndIfThenElse #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.DateZone -- Copyright : (c) Martin Perner -- License : BSD-style (see LICENSE) -- -- Maintainer : Martin Perner <martin@perner.cc> -- Stability : unstable -- Portability : unportable -- -- A date plugin with localization and location support for Xmobar -- -- Based on Plugins.Date -- -- Usage example: in template put -- -- > Run DateZone "%a %H:%M:%S" "de_DE.UTF-8" "UTC" "utcDate" 10 -- ----------------------------------------------------------------------------- module Xmobar.Plugins.DateZone (DateZone(..)) where import Xmobar.Run.Exec #ifdef DATEZONE import Control.Concurrent.STM import System.IO.Unsafe import System.Environment (lookupEnv) import Data.Maybe (fromMaybe) import Data.Time.Format import Data.Time.LocalTime import Data.Time.LocalTime.TimeZone.Olson import Data.Time.LocalTime.TimeZone.Series import Xmobar.System.Localize #if ! MIN_VERSION_time(1,5,0) import System.Locale (TimeLocale) #endif #else import System.IO import Xmobar.Plugins.Date #endif data DateZone = DateZone String String String String Int deriving (Read, Show) instance Exec DateZone where alias (DateZone _ _ _ a _) = a #ifndef DATEZONE start (DateZone f _ _ a r) cb = do hPutStrLn stderr $ "Warning: DateZone plugin needs -fwith_datezone."++ " Using Date plugin instead." start (Date f a r) cb #else start (DateZone f l z _ r) cb = do lock <- atomically $ takeTMVar localeLock setupTimeLocale l locale <- getTimeLocale atomically $ putTMVar localeLock lock if z /= "" then do tzdir <- lookupEnv "TZDIR" timeZone <- getTimeZoneSeriesFromOlsonFile ((fromMaybe "/usr/share/zoneinfo" tzdir) ++ "/" ++ z) go (dateZone f locale timeZone) else go (date f locale) where go func = doEveryTenthSeconds r $ func >>= cb {-# NOINLINE localeLock #-} -- ensures that only one plugin instance sets the locale localeLock :: TMVar Bool localeLock = unsafePerformIO (newTMVarIO False) date :: String -> TimeLocale -> IO String date format loc = getZonedTime >>= return . formatTime loc format dateZone :: String -> TimeLocale -> TimeZoneSeries -> IO String dateZone format loc timeZone = getZonedTime >>= return . formatTime loc format . utcToLocalTime' timeZone . zonedTimeToUTC -- zonedTime <- getZonedTime -- return $ formatTime loc format $ utcToLocalTime' timeZone $ zonedTimeToUTC zonedTime #endif �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/EWMH.hs��������������������������������������������������������������0000644�0000000�0000000�00000020076�07346545000�015665� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# OPTIONS_GHC -w #-} {-# LANGUAGE CPP, NamedFieldPuns, GeneralizedNewtypeDeriving #-} {-# LANGUAGE TupleSections, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.EWMH -- Copyright : (c) Spencer Janssen -- License : BSD-style (see LICENSE) -- -- Maintainer : Spencer Janssen <spencerjanssen@gmail.com> -- Stability : unstable -- Portability : unportable -- -- An experimental plugin to display EWMH pager information -- ----------------------------------------------------------------------------- module Xmobar.Plugins.EWMH (EWMH(..)) where import Control.Applicative (Applicative(..)) import Control.Monad.State import Control.Monad.Reader import Graphics.X11 hiding (Modifier, Color) import Graphics.X11.Xlib.Extras import Xmobar.Run.Exec import Codec.Binary.UTF8.String as UTF8 import Foreign.C (CChar, CLong) import Xmobar.X11.Events (nextEvent') import Data.List (intersperse, intercalate) import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set data EWMH = EWMH | EWMHFMT Component deriving (Read, Show) instance Exec EWMH where alias EWMH = "EWMH" start ew cb = allocaXEvent $ \ep -> execM $ do d <- asks display r <- asks root liftIO xSetErrorHandler liftIO $ selectInput d r propertyChangeMask handlers' <- mapM (\(a, h) -> liftM2 (,) (getAtom a) (return h)) handlers mapM_ ((=<< asks root) . snd) handlers' forever $ do liftIO . cb . fmtOf ew =<< get liftIO $ nextEvent' d ep e <- liftIO $ getEvent ep case e of PropertyEvent { ev_atom = a, ev_window = w } -> case lookup a handlers' of Just f -> f w _ -> return () _ -> return () return () defaultPP = Sep (Text " : ") [ Workspaces [Color "white" "black" :% Current, Hide :% Empty] , Layout , Color "#00ee00" "" :$ Short 120 :$ WindowName] fmtOf EWMH = flip fmt defaultPP fmtOf (EWMHFMT f) = flip fmt f sep :: [a] -> [[a]] -> [a] sep x xs = intercalate x $ filter (not . null) xs fmt :: EwmhState -> Component -> String fmt e (Text s) = s fmt e (l :+ r) = fmt e l ++ fmt e r fmt e (m :$ r) = modifier m $ fmt e r fmt e (Sep c xs) = sep (fmt e c) $ map (fmt e) xs fmt e WindowName = windowName $ Map.findWithDefault initialClient (activeWindow e) (clients e) fmt e Layout = layout e fmt e (Workspaces opts) = sep " " [foldr ($) n [modifier m | (m :% a) <- opts, a `elem` as] | (n, as) <- attrs] where stats i = [ (Current, i == currentDesktop e) , (Empty, Set.notMember i nonEmptys && i /= currentDesktop e) -- TODO for visible , (Visibl ] attrs :: [(String, [WsType])] attrs = [(n, [s | (s, b) <- stats i, b]) | (i, n) <- zip [0 ..] (desktopNames e)] nonEmptys = Set.unions . map desktops . Map.elems $ clients e modifier :: Modifier -> String -> String modifier Hide = const "" modifier (Color fg bg) = \x -> concat ["<fc=", fg, if null bg then "" else "," ++ bg , ">", x, "</fc>"] modifier (Short n) = take n modifier (Wrap l r) = \x -> l ++ x ++ r data Component = Text String | Component :+ Component | Modifier :$ Component | Sep Component [Component] | WindowName | Layout | Workspaces [WsOpt] deriving (Read, Show) infixr 0 :$ infixr 5 :+ data Modifier = Hide | Color String String | Short Int | Wrap String String deriving (Read, Show) data WsOpt = Modifier :% WsType | WSep Component deriving (Read, Show) infixr 0 :% data WsType = Current | Empty | Visible deriving (Read, Show, Eq) data EwmhConf = C { root :: Window , display :: Display } data EwmhState = S { currentDesktop :: CLong , activeWindow :: Window , desktopNames :: [String] , layout :: String , clients :: Map Window Client } deriving Show data Client = Cl { windowName :: String , desktops :: Set CLong } deriving Show getAtom :: String -> M Atom getAtom s = do d <- asks display liftIO $ internAtom d s False windowProperty32 :: String -> Window -> M (Maybe [CLong]) windowProperty32 s w = do C {display} <- ask a <- getAtom s liftIO $ getWindowProperty32 display a w windowProperty8 :: String -> Window -> M (Maybe [CChar]) windowProperty8 s w = do C {display} <- ask a <- getAtom s liftIO $ getWindowProperty8 display a w initialState :: EwmhState initialState = S 0 0 [] [] Map.empty initialClient :: Client initialClient = Cl "" Set.empty handlers, clientHandlers :: [(String, Updater)] handlers = [ ("_NET_CURRENT_DESKTOP", updateCurrentDesktop) , ("_NET_DESKTOP_NAMES", updateDesktopNames ) , ("_NET_ACTIVE_WINDOW", updateActiveWindow) , ("_NET_CLIENT_LIST", updateClientList) ] ++ clientHandlers clientHandlers = [ ("_NET_WM_NAME", updateName) , ("_NET_WM_DESKTOP", updateDesktop) ] newtype M a = M (ReaderT EwmhConf (StateT EwmhState IO) a) deriving (Monad, Functor, Applicative, MonadIO, MonadReader EwmhConf, MonadState EwmhState) execM :: M a -> IO a execM (M m) = do d <- openDisplay "" r <- rootWindow d (defaultScreen d) let conf = C r d evalStateT (runReaderT m (C r d)) initialState type Updater = Window -> M () updateCurrentDesktop, updateDesktopNames, updateActiveWindow :: Updater updateCurrentDesktop _ = do C {root} <- ask mwp <- windowProperty32 "_NET_CURRENT_DESKTOP" root case mwp of Just [x] -> modify (\s -> s { currentDesktop = x }) _ -> return () updateActiveWindow _ = do C {root} <- ask mwp <- windowProperty32 "_NET_ACTIVE_WINDOW" root case mwp of Just [x] -> modify (\s -> s { activeWindow = fromIntegral x }) _ -> return () updateDesktopNames _ = do C {root} <- ask mwp <- windowProperty8 "_NET_DESKTOP_NAMES" root case mwp of Just xs -> modify (\s -> s { desktopNames = parse xs }) _ -> return () where dropNull ('\0':xs) = xs dropNull xs = xs split [] = [] split xs = case span (/= '\0') xs of (x, ys) -> x : split (dropNull ys) parse = split . decodeCChar updateClientList _ = do C {root} <- ask mwp <- windowProperty32 "_NET_CLIENT_LIST" root case mwp of Just xs -> do cl <- gets clients let cl' = Map.fromList $ map ((, initialClient) . fromIntegral) xs dels = Map.difference cl cl' new = Map.difference cl' cl modify (\s -> s { clients = Map.union (Map.intersection cl cl') cl'}) mapM_ (unmanage . fst) (Map.toList dels) mapM_ (listen . fst) (Map.toList cl') mapM_ (update . fst) (Map.toList new) _ -> return () where unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0 listen w = asks display >>= \d -> liftIO $ selectInput d w propertyChangeMask update w = mapM_ (($ w) . snd) clientHandlers modifyClient :: Window -> (Client -> Client) -> M () modifyClient w f = modify (\s -> s { clients = Map.alter f' w $ clients s }) where f' Nothing = Just $ f initialClient f' (Just x) = Just $ f x updateName w = do mwp <- windowProperty8 "_NET_WM_NAME" w case mwp of Just xs -> modifyClient w (\c -> c { windowName = decodeCChar xs }) _ -> return () updateDesktop w = do mwp <- windowProperty32 "_NET_WM_DESKTOP" w case mwp of Just x -> modifyClient w (\c -> c { desktops = Set.fromList x }) _ -> return () decodeCChar :: [CChar] -> String decodeCChar = UTF8.decode . map fromIntegral ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/HandleReader.hs������������������������������������������������������0000644�0000000�0000000�00000004650�07346545000�017443� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.HandleReader -- Copyright : (c) Pavan Rikhi -- License : BSD-style (see LICENSE) -- -- Maintainer : Pavan Rikhi <pavan.rikhi@gmail.com> -- Stability : unstable -- Portability : portable -- -- A plugin for reading from 'Handle's -- ----------------------------------------------------------------------------- module Xmobar.Plugins.HandleReader ( HandleReader(..) ) where import System.IO ( Handle , hIsEOF , hGetLine ) import Xmobar.Run.Exec ( Exec(..) ) -- | A HandleReader displays any text received from a Handle. -- -- This is only useful if you are running @xmobar@ from other Haskell code. -- You can create a pair of @(read, write)@ 'Handle's using -- 'System.Process.createPipe'. Pass the @read@ 'Handle' to HandleReader -- and write your desired output to the @write@ 'Handle'. -- -- @ -- (readHandle, writeHandle) <- 'System.Process.createPipe' -- xmobarProcess <- 'System.Posix.Process.forkProcess' $ 'Xmobar.xmobar' myConfig -- { commands = -- 'Xmobar.Run' ('HandleReader' readHandle "handle") : 'Xmobar.commands' myConfig -- } -- 'System.IO.hPutStr' writeHandle "Hello World" -- @ data HandleReader = HandleReader Handle -- ^ The Handle to read from. String -- ^ Alias for the HandleReader deriving (Show) -- | WARNING: This Read instance will throw an exception if used! It is -- only implemented because it is required to use HandleReader with -- 'Xmobar.Run' in 'Xmobar.commands'. instance Read HandleReader where -- | Throws an 'error'! readsPrec = error "HandleReader: Read instance is stub" -- | Asynchronously read from the 'Handle'. instance Exec HandleReader where -- | Read from the 'Handle' until it is closed. start (HandleReader handle _) cb = untilM (hIsEOF handle) $ hGetLine handle >>= cb -- | Use the 2nd argument to HandleReader as its alias. alias (HandleReader _ a) = a -- Loop the action until predicateM returns True. untilM :: Monad m => m Bool -> m () -> m () untilM predicateM action = do predicate <- predicateM if predicate then return () else action >> untilM predicateM action ����������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Kbd.hs���������������������������������������������������������������0000644�0000000�0000000�00000005402�07346545000�015621� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Kbd -- Copyright : (c) Martin Perner -- License : BSD-style (see LICENSE) -- -- Maintainer : Martin Perner <martin@perner.cc> -- Stability : unstable -- Portability : unportable -- -- A keyboard layout indicator for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Kbd(Kbd(..)) where import Data.List (isPrefixOf) import Data.Maybe (fromMaybe) import Data.Char (toLower) import Control.Monad (forever) import Control.Applicative ((<|>)) import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras import Xmobar.Run.Exec import Xmobar.X11.Events (nextEvent') import Xmobar.System.Kbd -- 'Bad' prefixes of layouts noLaySymbols :: [String] noLaySymbols = ["group", "inet", "ctr", "compose", "pc", "ctrl", "terminate"] -- splits the layout string into the actual layouts splitLayout :: String -> [String] splitLayout s = filter flt . map (takeWhile (/= ':')) $ split (=='+') s where flt "" = False flt s' = not $ any (`isPrefixOf` s') noLaySymbols -- split String at each Char split :: (Char -> Bool) -> String -> [String] split p s = case break p s of (pref, _:suf) -> pref : split p suf (pref, "") -> [pref] -- replaces input string if on search list (exact match) with corresponding -- element on replacement list. -- -- if not found, return string unchanged searchReplaceLayout :: KbdOpts -> String -> String searchReplaceLayout opts s = fromMaybe s $ lookup s opts -- returns the active layout getKbdLay :: Display -> KbdOpts -> IO String getKbdLay dpy opts = do lay <- splitLayout <$> getLayoutStr dpy grps <- map (map toLower . take 2) <$> getGrpNames dpy curLay <- getKbdLayout dpy return $ searchReplaceLayout opts $ fromMaybe "??" $ (lay !!? curLay) <|> (grps !!? curLay) (!!?) :: [a] -> Int -> Maybe a (!!?) [] _ = Nothing (!!?) (x : _) 0 = Just x (!!?) (_ : xs) i = xs !!? (i - 1) newtype Kbd = Kbd [(String, String)] deriving (Read, Show) instance Exec Kbd where alias (Kbd _) = "kbd" start (Kbd opts) cb = do dpy <- openDisplay "" -- initial set of layout cb =<< getKbdLay dpy opts -- enable listing for -- group changes _ <- xkbSelectEventDetails dpy xkbUseCoreKbd xkbStateNotify xkbAllStateComponentsMask xkbGroupStateMask -- layout/geometry changes _ <- xkbSelectEvents dpy xkbUseCoreKbd xkbNewKeyboardNotifyMask xkbNewKeyboardNotifyMask allocaXEvent $ \e -> forever $ do nextEvent' dpy e _ <- getEvent e cb =<< getKbdLay dpy opts closeDisplay dpy return () ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Kraken.hs������������������������������������������������������������0000644�0000000�0000000�00000013047�07346545000�016340� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE DeriveGeneric #-} module Xmobar.Plugins.Kraken (Kraken(..)) where import Control.Concurrent (MVar, newEmptyMVar, putMVar, takeMVar) import Control.Concurrent.Async (async, cancel) import Control.Exception (bracket, catch) import Control.Monad (forever, mzero, void, when) import Data.Aeson import Data.Aeson.Types (Parser, typeMismatch) import Data.List (sort) import Data.Text (Text, pack, unpack) import GHC.Generics import Network.WebSockets (ClientApp, ConnectionException(ConnectionClosed), receiveData, sendTextData) import System.IO (hPutStrLn, stderr) import Text.Read (readMaybe) import Wuss (runSecureClient) import Xmobar.Run.Exec(Exec(..)) import qualified Data.HashMap.Lazy as HML (lookup) import qualified Data.Map as Map import qualified Data.Vector as V data Kraken = Kraken [String] String deriving (Read, Show) instance Exec Kraken where alias (Kraken _ a) = a start (Kraken ps _) cb = do mvar <- newEmptyMVar bracket (async $ reconnectOnConnectionClose $ wsClientApp ps mvar) cancel $ \_ -> do let loop mv p = do v <- takeMVar mv let g = Map.insert (unpack $ fst v) (snd v) p cb (display g) loop mv g loop mvar (Map.fromList $ map (, 0.0) ps) where display :: Map.Map String Double -> String display m = unwords $ sort $ map (\x -> fst x ++ ": " ++ show (snd x)) $ Map.toList m reconnectOnConnectionClose :: ClientApp () -> IO () reconnectOnConnectionClose ws = runSecureClient "ws.kraken.com" 443 "/" ws `catch` (\e -> when (e == ConnectionClosed) $ reconnectOnConnectionClose ws) wsClientApp :: [String] -> MVar (Text, Double) -> ClientApp () wsClientApp ps mvar connection = do sendTextData connection (encode Subscribe { event = "subscribe", pair = map pack ps, subscription = Subscription { name = "ticker" }}) void . forever $ do message <- receiveData connection case (eitherDecode message :: Either String Message) of Right m -> case m of TickerMessage _ ti _ tp -> putMVar mvar (tp, askPrice $ ask ti) _ -> return () Left e -> hPutStrLn stderr e data Ask = Ask { askPrice :: Double , askWholeLotVolume :: Int , askLotVolume :: Double } deriving Show parseDoubleString :: Value -> Parser Double parseDoubleString v = do j <- parseJSON v case readMaybe j of Just num -> return num Nothing -> typeMismatch "Double inside a String" v instance FromJSON Ask where parseJSON (Array v) | V.length v == 3 = do p <- parseDoubleString $ v V.! 0 w <- parseJSON $ v V.! 1 l <- parseDoubleString $ v V.! 2 return Ask { askPrice = p, askWholeLotVolume = w, askLotVolume = l } | otherwise = mzero parseJSON nonArray = typeMismatch "Array" nonArray data Bid = Bid { bidPrice :: Double , bidWholeLotVolume :: Int , bidLotVolume :: Double } deriving Show instance FromJSON Bid where parseJSON (Array v) | V.length v == 3 = do p <- parseDoubleString $ v V.! 0 w <- parseJSON $ v V.! 1 l <- parseDoubleString $ v V.! 2 return Bid { bidPrice = p, bidWholeLotVolume = w, bidLotVolume = l } | otherwise = mzero parseJSON nonArray = typeMismatch "Array" nonArray data Close = Close { closePrice :: Double , closeLotVolume :: Double } deriving Show instance FromJSON Close where parseJSON (Array v) | V.length v == 2 = do p <- parseDoubleString $ v V.! 0 l <- parseDoubleString $ v V.! 1 return Close { closePrice= p, closeLotVolume = l } | otherwise = mzero parseJSON nonArray = typeMismatch "Array" nonArray data TickerInformation = TickerInformation { ask :: Ask , bid :: Bid , close :: Close } deriving Show instance FromJSON TickerInformation where parseJSON = withObject "P" $ \v -> TickerInformation <$> v .: "a" <*> v .: "b" <*> v .: "c" data Message = Heartbeat | TickerMessage { channelId :: Int, tickerInformation :: TickerInformation, channelName :: Text, tickerPair :: Text } | SubscriptionStatus { channelName :: Text, status :: Text, subscriptionPair :: Text } | SystemStatus { connectionId :: Integer, status :: Text, version :: Text } | UnrecognizedMessage String deriving Show newtype Subscription = Subscription { name :: Text } deriving (Generic, Show) instance ToJSON Subscription where toEncoding = genericToEncoding defaultOptions data Subscribe = Subscribe { event :: Text, pair :: [Text], subscription :: Subscription } deriving (Generic, Show) instance ToJSON Subscribe where toEncoding = genericToEncoding defaultOptions instance FromJSON Message where parseJSON (Object o) = case HML.lookup (pack "event") o of Just (String "heartbeat") -> pure Heartbeat Just (String "systemStatus") -> systemStatus o Just (String "subscriptionStatus") -> subscriptionStatus o Just eventType -> pure $ UnrecognizedMessage $ "Unrecognized event type " ++ show eventType Nothing -> pure $ UnrecognizedMessage "Missing event" where systemStatus obj = SystemStatus <$> obj .: "connectionID" <*> obj .: "status" <*> obj .: "version" subscriptionStatus obj = SubscriptionStatus <$> obj .: "channelName" <*> obj .: "status" <*> obj .: "pair" parseJSON (Array a) | V.length a == 4 = do cId <- parseJSON $ a V.! 0 info <- parseJSON $ a V.! 1 cName <- parseJSON $ a V.! 2 p <- parseJSON $ a V.! 3 pure TickerMessage { channelId = cId, tickerInformation = info, channelName = cName, tickerPair = p } | otherwise = mzero parseJSON v = typeMismatch "Object or Array" v �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Locks.hs�������������������������������������������������������������0000644�0000000�0000000�00000003336�07346545000�016200� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- 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 Xmobar.Plugins.Locks(Locks(..)) where import Graphics.X11 import Data.List import Data.Bits import Control.Monad import Graphics.X11.Xlib.Extras import Xmobar.Run.Exec import Xmobar.System.Kbd import Xmobar.X11.Events (nextEvent') data Locks = Locks deriving (Read, Show) locks :: [ ( KeySym, String )] locks = [ ( xK_Caps_Lock, "CAPS" ) , ( xK_Num_Lock, "NUM" ) , ( xK_Scroll_Lock, "SCROLL" ) ] run' :: Display -> Window -> IO String run' d root = do modMap <- getModifierMapping d ( _, _, _, _, _, _, _, m ) <- queryPointer d root ls <- filterM ( \( ks, _ ) -> do kc <- keysymToKeycode d ks return $ case find (elem kc . snd) modMap of Nothing -> False Just ( i, _ ) -> testBit m (fromIntegral i) ) locks return $ unwords $ map snd ls instance Exec Locks where alias Locks = "locks" start Locks cb = do d <- openDisplay "" root <- rootWindow d (defaultScreen d) _ <- xkbSelectEventDetails d xkbUseCoreKbd xkbIndicatorStateNotify m m allocaXEvent $ \ep -> forever $ do cb =<< run' d root nextEvent' d ep getEvent ep closeDisplay d return () where m = xkbAllStateComponentsMask ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/MBox.hs��������������������������������������������������������������0000644�0000000�0000000�00000007636�07346545000�016001� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.MBox -- Copyright : (c) Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A plugin for checking mail in mbox files. -- ----------------------------------------------------------------------------- module Xmobar.Plugins.MBox (MBox(..)) where import Prelude import Xmobar.Run.Exec #ifdef INOTIFY import Xmobar.Plugins.Monitors.Common (parseOptsWith) import Xmobar.System.Utils (changeLoop, expandHome) import Control.Monad (when) import Control.Concurrent.STM import Control.Exception (SomeException (..), handle, evaluate) import System.Console.GetOpt import System.Directory (doesFileExist) import System.FilePath ((</>)) import System.INotify (Event(..), EventVariety(..), initINotify, addWatch) import qualified Data.ByteString.Lazy.Char8 as B #if MIN_VERSION_hinotify(0,3,10) import qualified Data.ByteString.Char8 as BS (ByteString, pack) pack :: String -> BS.ByteString pack = BS.pack #else pack :: String -> String pack = id #endif data Options = Options { oAll :: Bool , oUniq :: Bool , oDir :: FilePath , oPrefix :: String , oSuffix :: String } defaults :: Options defaults = Options { oAll = False, oUniq = False, oDir = "", oPrefix = "", oSuffix = "" } options :: [OptDescr (Options -> Options)] options = [ Option "a" ["all"] (NoArg (\o -> o { oAll = True })) "" , Option "u" [] (NoArg (\o -> o { oUniq = True })) "" , Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") "" , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") "" , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") "" ] #else import System.IO #endif -- | A list of display names, paths to mbox files and display colours, -- followed by a list of options. data MBox = MBox [(String, FilePath, String)] [String] String deriving (Read, Show) instance Exec MBox where alias (MBox _ _ a) = a #ifndef INOTIFY start _ _ = hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify" ++ " but the MBox plugin requires it" #else start (MBox boxes args _) cb = do opts <- parseOptsWith options defaults args let showAll = oAll opts prefix = oPrefix opts suffix = oSuffix opts uniq = oUniq opts names = map (\(t, _, _) -> t) boxes colors = map (\(_, _, c) -> c) boxes extractPath (_, f, _) = expandHome $ oDir opts </> f events = [CloseWrite] i <- initINotify vs <- mapM (\b -> do f <- extractPath b exists <- doesFileExist f n <- if exists then countMails f else return (-1) v <- newTVarIO (f, n) when exists $ addWatch i events (pack f) (handleNotification v) >> return () return v) boxes changeLoop (mapM (fmap snd . readTVar) vs) $ \ns -> let s = unwords [ showC uniq m n c | (m, n, c) <- zip3 names ns colors , showAll || n > 0 ] in cb (if null s then "" else prefix ++ s ++ suffix) showC :: Bool -> String -> Int -> String -> String showC u m n c = if c == "" then msg else "<fc=" ++ c ++ ">" ++ msg ++ "</fc>" where msg = m ++ if not u || n > 1 then show n else "" countMails :: FilePath -> IO Int countMails f = handle (\(SomeException _) -> evaluate 0) (do txt <- B.readFile f evaluate $! length . filter (B.isPrefixOf from) . B.lines $ txt) where from = B.pack "From " handleNotification :: TVar (FilePath, Int) -> Event -> IO () handleNotification v _ = do (p, _) <- atomically $ readTVar v n <- countMails p atomically $ writeTVar v (p, n) #endif ��������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Mail.hs��������������������������������������������������������������0000644�0000000�0000000�00000007324�07346545000�016010� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Mail -- Copyright : (c) Spencer Janssen -- License : BSD-style (see LICENSE) -- -- Maintainer : Spencer Janssen <sjanssen@cse.unl.edu> -- Stability : unstable -- Portability : unportable -- -- A plugin for checking mail. -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Mail(Mail(..),MailX(..)) where import Xmobar.Run.Exec #ifdef INOTIFY import Xmobar.Plugins.Monitors.Common (parseOptsWith) import Xmobar.System.Utils (expandHome, changeLoop) import Control.Monad import Control.Concurrent.STM import System.Directory import System.FilePath import System.INotify import System.Console.GetOpt import Data.List (isPrefixOf) import Data.Set (Set) import qualified Data.Set as S #if MIN_VERSION_hinotify(0,3,10) import qualified Data.ByteString.Char8 as BS (ByteString, pack, unpack) unpack :: BS.ByteString -> String unpack = BS.unpack pack :: String -> BS.ByteString pack = BS.pack #else unpack :: String -> String unpack = id pack :: String -> String pack = id #endif #else import System.IO #endif data MOptions = MOptions { oDir :: FilePath , oPrefix :: String , oSuffix :: String } defaults :: MOptions defaults = MOptions {oDir = "", oPrefix = "", oSuffix = ""} options :: [OptDescr (MOptions -> MOptions)] options = [ Option "d" ["dir"] (ReqArg (\x o -> o { oDir = x }) "") "" , Option "p" ["prefix"] (ReqArg (\x o -> o { oPrefix = x }) "") "" , Option "s" ["suffix"] (ReqArg (\x o -> o { oSuffix = x }) "") "" ] -- | A list of mail box names and paths to maildirs. data Mail = Mail [(String, FilePath)] String deriving (Read, Show) -- | A list of mail box names, paths to maildirs and display colors. data MailX = MailX [(String, FilePath, String)] [String] String deriving (Read, Show) instance Exec Mail where alias (Mail _ a) = a start (Mail ms a) = start (MailX (map (\(n,p) -> (n,p,"")) ms) [] a) instance Exec MailX where alias (MailX _ _ a) = a #ifndef INOTIFY start _ _ = hPutStrLn stderr $ "Warning: xmobar is not compiled with -fwith_inotify," ++ " but the Mail plugin requires it." #else start (MailX ms args _) cb = do vs <- mapM (const $ newTVarIO S.empty) ms opts <- parseOptsWith options defaults args let prefix = oPrefix opts suffix = oSuffix opts dir = oDir opts ps = map (\(_,p,_) -> if null dir then p else dir </> p) ms rs = map (</> "new") ps ev = [Move, MoveIn, MoveOut, Create, Delete] ds <- mapM expandHome rs i <- initINotify zipWithM_ (\d v -> addWatch i ev d (handle v)) (map pack ds) vs forM_ (zip ds vs) $ \(d, v) -> do s <- fmap (S.fromList . filter (not . isPrefixOf ".")) $ getDirectoryContents d atomically $ modifyTVar v (S.union s) changeLoop (mapM (fmap S.size . readTVar) vs) $ \ns -> let showmbx m n c = if c == "" then m ++ show n else "<fc=" ++ c ++ ">" ++ m ++ show n ++ "</fc>" cnts = [showmbx m n c | ((m,_,c), n) <- zip ms ns , n /= 0 ] in cb $ if null cnts then "" else prefix ++ unwords cnts ++ suffix handle :: TVar (Set String) -> Event -> IO () handle v e = atomically $ modifyTVar v $ case e of Created {} -> create MovedIn {} -> create Deleted {} -> delete MovedOut {} -> delete _ -> id where delete = S.delete ((unpack . filePath) e) create = S.insert ((unpack . filePath) e) #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/MarqueePipeReader.hs�������������������������������������������������0000644�0000000�0000000�00000005267�07346545000�020472� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.MarqueePipeReader -- Copyright : (c) Reto Habluetzel -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A plugin for reading from named pipes for long texts with marquee -- ----------------------------------------------------------------------------- module Xmobar.Plugins.MarqueePipeReader(MarqueePipeReader(..)) where import System.IO (openFile, IOMode(ReadWriteMode), Handle, hGetLine) import Xmobar.System.Environment import Xmobar.Run.Exec(Exec(alias, start), tenthSeconds) import System.Posix.Files (getFileStatus, isNamedPipe) import Control.Concurrent(forkIO, threadDelay) import Control.Concurrent.STM (TChan, atomically, writeTChan, tryReadTChan, newTChan) import Control.Exception import Control.Monad(forever, unless) type Length = Int -- length of the text to display type Rate = Int -- delay in tenth seconds type Separator = String -- if text wraps around, use separator data MarqueePipeReader = MarqueePipeReader String (Length, Rate, Separator) String deriving (Read, Show) instance Exec MarqueePipeReader where alias (MarqueePipeReader _ _ a) = a start (MarqueePipeReader p (len, rate, sep) _) cb = do (def, pipe) <- split ':' <$> expandEnv p unless (null def) (cb def) checkPipe pipe h <- openFile pipe ReadWriteMode line <- hGetLine h chan <- atomically newTChan forkIO $ writer (toInfTxt line sep) sep len rate chan cb forever $ pipeToChan h chan where split c xs | c `elem` xs = let (pre, post) = span (c /=) xs in (pre, dropWhile (c ==) post) | otherwise = ([], xs) pipeToChan :: Handle -> TChan String -> IO () pipeToChan h chan = do line <- hGetLine h atomically $ writeTChan chan line writer :: String -> Separator -> Length -> Rate -> TChan String -> (String -> IO ()) -> IO () writer txt sep len rate chan cb = do cb (take len txt) mbnext <- atomically $ tryReadTChan chan case mbnext of Just new -> writer (toInfTxt new sep) sep len rate chan cb Nothing -> tenthSeconds rate >> writer (drop 1 txt) sep len rate chan cb toInfTxt :: String -> String -> String toInfTxt line sep = concat (repeat $ line ++ " " ++ sep ++ " ") checkPipe :: FilePath -> IO () checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do status <- getFileStatus file unless (isNamedPipe status) waitForPipe where waitForPipe = threadDelay 1000 >> checkPipe file �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors.hs����������������������������������������������������������0000644�0000000�0000000�00000016312�07346545000�016735� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Plugins.Monitors -- Copyright : (c) 2010-2013, 2017-2020, 2022 Jose Antonio Ortega Ruiz -- (c) 2007-10 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- The system monitor plugin for Xmobar. -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors where import Xmobar.Run.Exec import Xmobar.Plugins.Monitors.Common (runM) #ifdef WEATHER import Xmobar.Plugins.Monitors.Weather #endif import Xmobar.Plugins.Monitors.Net import Xmobar.Plugins.Monitors.Mem import Xmobar.Plugins.Monitors.Swap import Xmobar.Plugins.Monitors.Cpu import Xmobar.Plugins.Monitors.MultiCpu import Xmobar.Plugins.Monitors.Batt import Xmobar.Plugins.Monitors.Bright import Xmobar.Plugins.Monitors.Load import Xmobar.Plugins.Monitors.Thermal import Xmobar.Plugins.Monitors.ThermalZone import Xmobar.Plugins.Monitors.CpuFreq import Xmobar.Plugins.Monitors.CoreTemp import Xmobar.Plugins.Monitors.MultiCoreTemp import Xmobar.Plugins.Monitors.K10Temp import Xmobar.Plugins.Monitors.Disk import Xmobar.Plugins.Monitors.Top import Xmobar.Plugins.Monitors.Uptime import Xmobar.Plugins.Monitors.CatInt #ifdef UVMETER import Xmobar.Plugins.Monitors.UVMeter #endif #if defined IWLIB || defined USE_NL80211 import Xmobar.Plugins.Monitors.Wireless #endif #ifdef LIBMPD import Xmobar.Plugins.Monitors.MPD import Xmobar.Plugins.Monitors.Common (runMBD, runMD) #endif #ifdef ALSA import Xmobar.Plugins.Monitors.Volume import Xmobar.Plugins.Monitors.Alsa #endif #ifdef MPRIS import Xmobar.Plugins.Monitors.Mpris #endif data Monitors = Network Interface Args Rate | DynNetwork Args Rate | BatteryP Args Args Rate | BatteryN Args Args Rate Alias | Battery Args Rate | DiskU DiskSpec Args Rate | DiskIO DiskSpec Args Rate | Load Args Rate | Thermal Zone Args Rate | ThermalZone ZoneNo Args Rate | Memory Args Rate | Swap Args Rate | Cpu Args Rate | MultiCpu Args Rate | Brightness Args Rate | CpuFreq Args Rate | CoreTemp Args Rate | MultiCoreTemp Args Rate | K10Temp Slot Args Rate | TopProc Args Rate | TopMem Args Rate | Uptime Args Rate | CatInt Int FilePath Args Rate #ifdef WEATHER | Weather Station Args Rate | WeatherX Station SkyConditions Args Rate #endif #ifdef UVMETER | UVMeter Station Args Rate #endif #if defined IWLIB || defined USE_NL80211 | Wireless Interface Args Rate #endif #ifdef LIBMPD | MPD Args Rate | MPDX Args Rate Alias | AutoMPD Args #endif #ifdef ALSA | Volume String String Args Rate | Alsa String String Args #endif #ifdef MPRIS | Mpris1 String Args Rate | Mpris2 String Args Rate #endif deriving (Show,Read,Eq) type Args = [String] type Program = String type Alias = String type Station = String type SkyConditions = [(String, String)] type Zone = String type ZoneNo = Int type Interface = String type Rate = Int type DiskSpec = [(String, String)] type Slot = String instance Exec Monitors where #ifdef WEATHER alias (Weather s _ _) = s alias (WeatherX s _ _ _) = s #endif alias (Network i _ _) = i alias (DynNetwork _ _) = "dynnetwork" alias (Load _ _) = "load" alias (Thermal z _ _) = z alias (ThermalZone z _ _) = "thermal" ++ show z alias (Memory _ _) = "memory" alias (Swap _ _) = "swap" alias (Cpu _ _) = "cpu" alias (MultiCpu _ _) = "multicpu" alias (Battery _ _) = "battery" alias BatteryP {} = "battery" alias (BatteryN _ _ _ a)= a alias (Brightness _ _) = "bright" alias (CpuFreq _ _) = "cpufreq" alias (TopProc _ _) = "top" alias (TopMem _ _) = "topmem" alias (CoreTemp _ _) = "coretemp" alias (MultiCoreTemp _ _) = "multicoretemp" alias K10Temp {} = "k10temp" alias DiskU {} = "disku" alias DiskIO {} = "diskio" alias (Uptime _ _) = "uptime" alias (CatInt n _ _ _) = "cat" ++ show n #ifdef UVMETER alias (UVMeter s _ _) = "uv " ++ s #endif #if defined IWLIB || defined USE_NL80211 alias (Wireless i _ _) = i ++ "wi" #endif #ifdef LIBMPD alias (MPD _ _) = "mpd" alias (AutoMPD _) = "autompd" alias (MPDX _ _ a) = a #endif #ifdef ALSA alias (Volume m c _ _) = m ++ ":" ++ c alias (Alsa m c _) = "alsa:" ++ m ++ ":" ++ c #endif #ifdef MPRIS alias (Mpris1 _ _ _) = "mpris1" 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 start (TopMem a r) = runM a topMemConfig runTopMem r #ifdef WEATHER start (Weather s a r) = startWeather s a r start (WeatherX s c a r) = startWeather' c s a r #endif start (Thermal z a r) = runM (a ++ [z]) thermalConfig runThermal r start (ThermalZone z a r) = runM (a ++ [show z]) thermalZoneConfig runThermalZone r start (Load a r) = runM a loadConfig runLoad r start (Memory a r) = runM a memConfig runMem r start (Swap a r) = runM a swapConfig runSwap r start (Battery a r) = runM a battConfig runBatt r start (BatteryP s a r) = runM a battConfig (runBatt' s) r start (BatteryN s a r _) = runM a battConfig (runBatt' s) r start (Brightness a r) = runM a brightConfig runBright r start (CpuFreq a r) = runM a cpuFreqConfig runCpuFreq r start (CoreTemp a r) = runM a coreTempConfig runCoreTemp r start (MultiCoreTemp a r) = startMultiCoreTemp a r start (K10Temp s a r) = runM (a ++ [s]) k10TempConfig runK10Temp r start (DiskU s a r) = runM a diskUConfig (runDiskU s) r start (DiskIO s a r) = startDiskIO s a r start (Uptime a r) = runM a uptimeConfig runUptime r start (CatInt _ s a r) = runM a catIntConfig (runCatInt s) r #ifdef UVMETER start (UVMeter s a r) = startUVMeter s a r #endif #if defined IWLIB || defined USE_NL80211 start (Wireless i a r) = runM a wirelessConfig (runWireless i) r #endif #ifdef LIBMPD start (MPD a r) = runMD a mpdConfig runMPD r mpdReady start (MPDX a r _) = start (MPD a r) start (AutoMPD a) = runMBD a mpdConfig runMPD mpdWait mpdReady #endif #ifdef ALSA start (Volume m c a r) = runM a volumeConfig (runVolume m c) r start (Alsa m c a) = startAlsaPlugin m c a #endif #ifdef MPRIS start (Mpris1 s a r) = runM a mprisConfig (runMPRIS1 s) r start (Mpris2 s a r) = runM a mprisConfig (runMPRIS2 s) r #endif ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�016376� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Alsa.hs�����������������������������������������������������0000644�0000000�0000000�00000014150�07346545000�017613� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Alsa -- Copyright : (c) 2018 Daniel Schüssler -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Event-based variant of the Volume plugin. -- ----------------------------------------------------------------------------- {-# LANGUAGE PatternGuards #-} module Xmobar.Plugins.Monitors.Alsa ( startAlsaPlugin , withMonitorWaiter , parseOptsIncludingMonitorArgs , AlsaOpts(aoAlsaCtlPath) ) where import Control.Concurrent import Control.Concurrent.Async import Control.Exception import Control.Monad import Data.IORef import Data.Time.Clock import Xmobar.Plugins.Monitors.Common import qualified Xmobar.Plugins.Monitors.Volume as Volume; import System.Console.GetOpt import System.Directory import System.Exit import System.IO import System.IO.Error import System.Process alsaCtlRestartRateLimit :: NominalDiffTime alsaCtlRestartRateLimit = 3 -- 'Num NominalDiffTime' assumes seconds data AlsaOpts = AlsaOpts { aoVolumeOpts :: Volume.VolumeOpts , aoAlsaCtlPath :: Maybe FilePath } defaultOpts :: AlsaOpts defaultOpts = AlsaOpts Volume.defaultOpts Nothing alsaCtlOptionName :: String alsaCtlOptionName = "alsactl" options :: [OptDescr (AlsaOpts -> AlsaOpts)] options = Option "" [alsaCtlOptionName] (ReqArg (\x o -> o { aoAlsaCtlPath = Just x }) "") "" : fmap (fmap modifyVolumeOpts) Volume.options where modifyVolumeOpts f o = o { aoVolumeOpts = f (aoVolumeOpts o) } -- | Drop generic Monitor args first, then apply 'parseOptsWith' in order to -- parse everything. parseOptsIncludingMonitorArgs :: [String] -> IO AlsaOpts parseOptsIncludingMonitorArgs args = case getOpt Permute [] args of (_, args', _) -> parseOptsWith options defaultOpts args' startAlsaPlugin :: String -> String -> [String] -> (String -> IO ()) -> IO () startAlsaPlugin mixerName controlName args cb = do opts <- parseOptsIncludingMonitorArgs args let run args2 = do -- Replicating the reparsing logic used by other plugins for now, -- but it seems the option parsing could be floated out (actually, -- GHC could in principle do it already since getOpt is pure, but -- it would have to inline 'runMBD', 'doArgs' and 'parseOpts' to see -- it, which probably isn't going to happen with the default -- optimization settings). opts2 <- io $ parseOptsWith options defaultOpts args2 Volume.runVolumeWith (aoVolumeOpts opts2) mixerName controlName withMonitorWaiter mixerName (aoAlsaCtlPath opts) cb $ \wait_ -> runMB args Volume.volumeConfig run wait_ cb withMonitorWaiter :: String -> Maybe FilePath -> (String -> IO ()) -> (IO () -> IO a) -> IO a withMonitorWaiter mixerName alsaCtlPathOverride outputCallback cont = do mvar <- newMVar () effectivePath <- determineAlsaCtlPath bracket (async $ alsaReaderThread mixerName effectivePath outputCallback mvar) cancel $ \a -> do -- Throw on this thread if there's an exception -- on the reader thread. link a cont $ takeMVar mvar where defaultPath = "/usr/sbin/alsactl" determineAlsaCtlPath = case alsaCtlPathOverride of Just path -> do found <- doesFileExist path if found then pure path else throwIO . ErrorCall $ "Specified alsactl file " ++ path ++ " does not exist" Nothing -> do (ec, path, err) <- readProcessWithExitCode "which" ["alsactl"] "" unless (null err) $ hPutStrLn stderr err case ec of ExitSuccess -> pure $ trimTrailingNewline path ExitFailure _ -> do found <- doesFileExist defaultPath if found then pure defaultPath else throwIO . ErrorCall $ "alsactl not found in PATH or at " ++ show defaultPath ++ "; please specify with --" ++ alsaCtlOptionName ++ "=/path/to/alsactl" alsaReaderThread :: String -> String -> (String -> IO a) -> MVar () -> IO b alsaReaderThread mixerName alsaCtlPath outputCallback mvar = let createProc = (proc "stdbuf" ["-oL", alsaCtlPath, "monitor", mixerName]) {std_out = CreatePipe} runAlsaOnce = withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do hSetBuffering alsaOut LineBuffering tryPutMVar mvar () -- Refresh immediately after restarting alsactl forever $ do c <- hGetChar alsaOut when (c == '\n') $ -- This uses 'tryPutMVar' because 'putMVar' would make 'runVolume' run -- once for each event. But we want it to run only once after a burst -- of events. void $ tryPutMVar mvar () in do limiter <- createRateLimiter alsaCtlRestartRateLimit forever $ do limiter catchJust (guard . isEOFError) runAlsaOnce pure outputCallback "Restarting alsactl..." -- This is necessarily very inefficient on 'String's trimTrailingNewline :: String -> String trimTrailingNewline x = case reverse x of '\n' : '\r' : y -> reverse y '\n' : y -> reverse y _ -> x -- | -- Returns an IO action that completes at most once per @interval@. -- The returned cation is not safe for concurrent use. createRateLimiter :: NominalDiffTime -> IO (IO ()) createRateLimiter interval = do prevTimeRef <- newIORef Nothing let limiter = do prevTime0 <- readIORef prevTimeRef curTime <- getCurrentTime case prevTime0 of Just prevTime | diff <- interval - (curTime `diffUTCTime` prevTime), diff > 0 -> do threadDelayNDT diff writeIORef prevTimeRef . Just =<< getCurrentTime _ -> writeIORef prevTimeRef (Just curTime) pure limiter threadDelayNDT :: NominalDiffTime -> IO () threadDelayNDT ndt = threadDelay (round (realToFrac ndt * 1e6 :: Double)) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Batt.hs�����������������������������������������������������0000644�0000000�0000000�00000014557�07346545000�017640� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Batt -- Copyright : (c) 2010-2013, 2015, 2016, 2018, 2019, 2022 Jose A Ortega -- (c) 2010 Andrea Rossato, Petr Rockai -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A battery monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Batt (battConfig, runBatt, runBatt') where import Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..), Result(..), Status(..)) import Xmobar.Plugins.Monitors.Common import System.Console.GetOpt #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Batt.FreeBSD as MB #else import qualified Xmobar.Plugins.Monitors.Batt.Linux as MB #endif defaultOpts :: BattOpts defaultOpts = BattOpts { onString = "On" , offString = "Off" , idleString = "On" , posColor = Nothing , lowWColor = Nothing , mediumWColor = Nothing , highWColor = Nothing , onLowAction = Nothing , actionThreshold = 6 , lowThreshold = 10 , highThreshold = 12 , onlineFile = "AC/online" , scale = 1e6 , onIconPattern = Nothing , offIconPattern = Nothing , idleIconPattern = Nothing , lowString = "" , mediumString = "" , highString = "" , incPerc = False } options :: [OptDescr (BattOpts -> BattOpts)] options = [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") "" , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") "" , Option "i" ["idle"] (ReqArg (\x o -> o { idleString = x }) "") "" , Option "p" ["positive"] (ReqArg (\x o -> o { posColor = Just x }) "") "" , Option "l" ["low"] (ReqArg (\x o -> o { lowWColor = Just x }) "") "" , Option "m" ["medium"] (ReqArg (\x o -> o { mediumWColor = Just x }) "") "" , Option "h" ["high"] (ReqArg (\x o -> o { highWColor = Just x }) "") "" , Option "L" ["lowt"] (ReqArg (\x o -> o { lowThreshold = read x }) "") "" , Option "H" ["hight"] (ReqArg (\x o -> o { highThreshold = read x }) "") "" , Option "f" ["online"] (ReqArg (\x o -> o { onlineFile = x }) "") "" , Option "s" ["scale"] (ReqArg (\x o -> o {scale = read x}) "") "" , Option "a" ["action"] (ReqArg (\x o -> o { onLowAction = Just x }) "") "" , Option "P" ["percent"] (NoArg (\o -> o {incPerc = True})) "" , Option "A" ["action-threshold"] (ReqArg (\x o -> o { actionThreshold = read x }) "") "" , Option "" ["on-icon-pattern"] (ReqArg (\x o -> o { onIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["off-icon-pattern"] (ReqArg (\x o -> o { offIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["idle-icon-pattern"] (ReqArg (\x o -> o { idleIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["lows"] (ReqArg (\x o -> o { lowString = x }) "") "" , Option "" ["mediums"] (ReqArg (\x o -> o { mediumString = x }) "") "" , Option "" ["highs"] (ReqArg (\x o -> o { highString = x }) "") "" ] battConfig :: IO MConfig battConfig = mkMConfig "Batt: <watts>, <left>% / <timeleft>" vs where vs = ["leftbar", "leftvbar", "left" , "acstatus", "timeleft", "watts", "leftipat"] data BatteryStatus = BattHigh | BattMedium | BattLow -- | Convert the current battery charge into a 'BatteryStatus' getBattStatus :: Float -- ^ Current battery charge, assumed to be in [0,1] -> BattOpts -- ^ Battery options, including high/low thresholds -> BatteryStatus getBattStatus charge opts | c >= highThreshold opts = BattHigh | c >= lowThreshold opts = BattMedium | otherwise = BattLow where c = 100 * min 1 charge runBatt :: [String] -> Monitor String runBatt = runBatt' ["BAT", "BAT0", "BAT1", "BAT2"] runBatt' :: [String] -> [String] -> Monitor String runBatt' bfs args = do opts <- io $ parseOptsWith options defaultOpts args c <- io $ MB.readBatteries opts bfs formatResult c opts formatResult :: Result -> BattOpts -> Monitor String formatResult res bopt = do let sp = incPerc bopt suffix <- getConfigValue useSuffix d <- getConfigValue decDigits nas <- getConfigValue naString case res of Result x w t s -> do l <- fmtPercent x sp ws <- fmtWatts w bopt suffix d si <- getIconPattern bopt s x st <- showWithColors' (fmtStatus bopt s nas (getBattStatus x bopt)) (100 * x) parseTemplate (l ++ [st, fmtTime $ floor t, ws, si]) NA -> getConfigValue naString fmtWatts :: Float -> BattOpts -> Bool -> Int -> Monitor String fmtWatts x o s d = do ws <- showWithPadding $ showDigits d x ++ (if s then "W" else "") return $ color x o ws color :: Float -> BattOpts -> String -> String color x o | x >= 0 = maybeColor (posColor o) | -x >= highThreshold o = maybeColor (highWColor o) | -x >= lowThreshold o = maybeColor (mediumWColor o) | otherwise = maybeColor (lowWColor o) fmtTime :: Integer -> String fmtTime x = hours ++ ":" ++ if length minutes == 2 then minutes else '0' : minutes where hours = show (x `div` 3600) minutes = show ((x `mod` 3600) `div` 60) fmtPercent :: Float -> Bool -> Monitor [String] fmtPercent x sp = do let x' = min 1 x pc <- if sp then colorizeString (100 * x') "%" else return "" p <- showPercentWithColors x' b <- showPercentBar (100 * x') x' vb <- showVerticalBar (100 * x') x' return [b, vb, p ++ pc] fmtStatus :: BattOpts -> Status -> String -> BatteryStatus -> String fmtStatus opts Idle _ _ = idleString opts fmtStatus _ Unknown na _ = na fmtStatus opts Full _ _ = idleString opts fmtStatus opts Charging _ _ = onString opts fmtStatus opts Discharging _ battStatus = (case battStatus of BattHigh -> highString BattMedium -> mediumString BattLow -> lowString) opts ++ offString opts maybeColor :: Maybe String -> String -> String maybeColor Nothing str = str maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>" getIconPattern :: BattOpts -> Status -> Float -> Monitor String getIconPattern opts st x = do let x' = min 1 x case st of Unknown -> showIconPattern (offIconPattern opts) x' Idle -> showIconPattern (idleIconPattern opts) x' Full -> showIconPattern (idleIconPattern opts) x' Charging -> showIconPattern (onIconPattern opts) x' Discharging -> showIconPattern (offIconPattern opts) x' �������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Batt/�������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017270� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Batt/Common.hs����������������������������������������������0000644�0000000�0000000�00000003521�07346545000�021055� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Batt.Common -- Copyright : (c) 2010, 2011, 2012, 2013, 2015, 2016, 2018, 2019 Jose A Ortega -- (c) 2010 Andrea Rossato, Petr Rockai -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A battery monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..) , Result(..) , Status(..) , maybeAlert) where import System.Process (system) import Control.Monad (unless, void) import Xmobar.Plugins.Monitors.Common data Status = Charging | Discharging | Full | Idle | Unknown deriving (Read, Eq) -- Result perc watts time-seconds Status data Result = Result Float Float Float Status | NA data BattOpts = BattOpts { onString :: String , offString :: String , idleString :: String , posColor :: Maybe String , lowWColor :: Maybe String , mediumWColor :: Maybe String , highWColor :: Maybe String , lowThreshold :: Float , highThreshold :: Float , onLowAction :: Maybe String , actionThreshold :: Float , onlineFile :: FilePath , scale :: Float , onIconPattern :: Maybe IconPattern , offIconPattern :: Maybe IconPattern , idleIconPattern :: Maybe IconPattern , lowString :: String , mediumString :: String , highString :: String , incPerc :: Bool } maybeAlert :: BattOpts -> Float -> IO () maybeAlert opts left = case onLowAction opts of Nothing -> return () Just x -> unless (isNaN left || actionThreshold opts < 100 * left) $ void $ system x �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Batt/FreeBSD.hs���������������������������������������������0000644�0000000�0000000�00000003113�07346545000�021034� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Batt.FreeBSD -- Copyright : (c) 2010, 2011, 2012, 2013, 2015, 2016, 2018, 2019 Jose A Ortega -- (c) 2010 Andrea Rossato, Petr Rockai -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A battery monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Batt.FreeBSD (readBatteries) where import Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..) , Result(..) , Status(..) , maybeAlert) import Control.Monad (unless) import System.BSD.Sysctl (sysctlReadInt) battStatus :: Int -> Status battStatus x | x == 1 = Discharging | x == 2 = Charging | otherwise = Unknown readBatteries :: BattOpts -> [String] -> IO Result readBatteries opts _ = do lf <- sysctlReadInt "hw.acpi.battery.life" rt <- sysctlReadInt "hw.acpi.battery.rate" tm <- sysctlReadInt "hw.acpi.battery.time" st <- sysctlReadInt "hw.acpi.battery.state" acline <- sysctlReadInt "hw.acpi.acline" let p = fromIntegral lf / 100 w = fromIntegral rt t = fromIntegral tm * 60 ac = acline == 1 -- battery full when rate is 0 and on ac. sts = if w == 0 && ac then Full else battStatus $ fromIntegral st unless ac (maybeAlert opts p) return (Result p w t sts) �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Batt/Linux.hs�����������������������������������������������0000644�0000000�0000000�00000017076�07346545000�020736� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Batt.Linux -- Copyright : (c) 2010-2013, 2015, 2016, 2018, 2019, 2022 Jose A Ortega -- (c) 2010 Andrea Rossato, Petr Rockai -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A battery monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Batt.Linux (readBatteries) where import Xmobar.Plugins.Monitors.Batt.Common ( BattOpts(..) , Result(..) , Status(..) , maybeAlert) import Control.Monad (unless) import Control.Exception (SomeException, handle) import System.FilePath ((</>)) import System.IO (IOMode(ReadMode), hGetLine, withFile, Handle) import Data.List (sort, sortBy, group) import Data.Maybe (fromMaybe) import Data.Ord (comparing) import Text.Read (readMaybe) data Files = Files { fEFull :: String , fCFull :: String , fEFullDesign :: String , fCFullDesign :: String , fENow :: String , fCNow :: String , fVoltage :: String , fVoltageMin :: String , fCurrent :: String , fPower :: String , fStatus :: String , fBat :: String } deriving Eq -- the default basenames of the possibly available attributes exposed -- by the kernel defaultFiles :: Files defaultFiles = Files { fEFull = "energy_full" , fCFull = "charge_full" , fEFullDesign = "energy_full_design" , fCFullDesign = "charge_full_design" , fENow = "energy_now" , fCNow = "charge_now" , fVoltage = "voltage_now" , fVoltageMin = "voltage_min_design" , fCurrent = "current_now" , fPower = "power_now" , fStatus = "status" , fBat = "BAT0" } type FilesAccessor = Files -> String sysDir :: FilePath sysDir = "/sys/class/power_supply" battFile :: FilesAccessor -> Files -> FilePath battFile accessor files = sysDir </> fBat files </> accessor files grabNumber :: (Num a, Read a) => FilesAccessor -> Files -> IO (Maybe a) grabNumber = grabFile (fmap read . hGetLine) grabString :: FilesAccessor -> Files -> IO (Maybe String) grabString = grabFile hGetLine -- grab file contents returning Nothing if the file doesn't exist or -- any other error occurs grabFile :: (Handle -> IO a) -> FilesAccessor -> Files -> IO (Maybe a) grabFile readMode accessor files = handle (onFileError Nothing) (withFile f ReadMode (fmap Just . readMode)) where f = battFile accessor files onFileError :: a -> SomeException -> IO a onFileError returnOnError = const (return returnOnError) -- get the filenames for a given battery name batteryFiles :: String -> Files batteryFiles bat = defaultFiles { fBat = bat } data Battery = Battery { full :: !Float , now :: !Float , power :: !Float , status :: !String } haveAc :: FilePath -> IO Bool haveAc f = handle (onFileError False) $ withFile (sysDir </> f) ReadMode (fmap (== "1") . hGetLine) -- retrieve the currently drawn power in Watt -- sc is a scaling factor which by kernel documentation must be 1e6 readBatPower :: Float -> Files -> IO (Maybe Float) readBatPower sc f = do pM <- grabNumber fPower f cM <- grabNumber fCurrent f vM <- grabNumber fVoltage f return $ case (pM, cM, vM) of (Just pVal, _, _) -> Just $ pVal / sc (_, Just cVal, Just vVal) -> Just $ cVal * vVal / (sc * sc) (_, _, _) -> Nothing -- retrieve the maximum capacity in Watt hours -- sc is a scaling factor which by kernel documentation must be 1e6 -- on getting the voltage: using voltage_min_design will probably underestimate -- the actual energy content of the battery and using voltage_now will probably -- overestimate it. readBatCapacityFull :: Float -> Files -> IO (Maybe Float) readBatCapacityFull sc f = do cM <- grabNumber fCFull f eM <- grabNumber fEFull f cdM <- grabNumber fCFullDesign f edM <- grabNumber fEFullDesign f -- not sure if Voltage or VoltageMin is more accurate and if both -- are always available vM <- grabNumber fVoltageMin f return $ case (eM, cM, edM, cdM, vM) of (Just eVal, _, _, _, _) -> Just $ eVal / sc (_, Just cVal, _, _, Just vVal) -> Just $ cVal * vVal / (sc * sc) (_, _, Just eVal, _, _) -> Just $ eVal / sc (_, _, _, Just cVal, Just vVal) -> Just $ cVal * vVal / (sc * sc) (_, _, _, _, _) -> Nothing -- retrieve the current capacity in Watt hours -- sc is a scaling factor which by kernel documentation must be 1e6 -- on getting the voltage: using voltage_min_design will probably underestimate -- the actual energy content of the battery and using voltage_now will probably -- overestimate it. readBatCapacityNow :: Float -> Files -> IO (Maybe Float) readBatCapacityNow sc f = do cM <- grabNumber fCNow f eM <- grabNumber fENow f vM <- grabNumber fVoltageMin f -- not sure if Voltage or -- VoltageMin is more accurate -- and if both are always -- available return $ case (eM, cM, vM) of (Just eVal, _, _) -> Just $ eVal / sc (_, Just cVal, Just vVal) -> Just $ cVal * vVal / (sc * sc) (_, _, _) -> Nothing readBatStatus :: Files -> IO (Maybe String) readBatStatus = grabString fStatus -- collect all relevant battery values with defaults of not available readBattery :: Float -> Files -> IO Battery readBattery sc files = do cFull <- withDef 0 readBatCapacityFull cNow <- withDef 0 readBatCapacityNow pwr <- withDef 0 readBatPower s <- withDef "Unknown" (const readBatStatus) let cFull' = max cFull cNow -- sometimes the reported max -- charge is lower than return $ Battery (3600 * cFull') -- wattseconds (3600 * cNow) -- wattseconds (abs pwr) -- watts s -- string: Discharging/Charging/Full where withDef d reader = fromMaybe d `fmap` reader sc files -- sortOn is only available starting at ghc 7.10 sortOn :: Ord b => (a -> b) -> [a] -> [a] sortOn f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x)) mostCommonDef :: Eq a => a -> [a] -> a mostCommonDef x xs = head $ last $ [x] : sortOn length (group xs) readBatteries :: BattOpts -> [String] -> IO Result readBatteries opts bfs = do let bfs'' = map batteryFiles bfs bats <- mapM (readBattery (scale opts)) (take 3 bfs'') ac <- haveAc (onlineFile opts) let sign = if ac then 1 else -1 ft = sum (map full bats) -- total capacity when full left = if ft > 0 then sum (map now bats) / ft else 0 watts = sign * sum (map power bats) time = if watts == 0 then 0 else max 0 (sum $ map time' bats) mwatts = if watts == 0 then 1 else sign * watts time' b = (if ac then full b - now b else now b) / mwatts statuses :: [Status] statuses = map (fromMaybe Unknown . readMaybe) (sort (map status bats)) acst = mostCommonDef Unknown $ filter (Unknown/=) statuses racst | acst /= Unknown = acst | time == 0 = Idle | ac = Charging | otherwise = Discharging unless ac (maybeAlert opts left) return $ if isNaN left then NA else Result left watts time racst ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Bright.hs���������������������������������������������������0000644�0000000�0000000�00000006455�07346545000�020163� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- ---- | ---- Module : Plugins.Monitors.Birght ---- Copyright : (c) Martin Perner ---- License : BSD-style (see LICENSE) ---- ---- Maintainer : Martin Perner <martin@perner.cc> ---- Stability : unstable ---- Portability : unportable ---- ---- A screen brightness monitor for Xmobar ---- ------------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Bright (brightConfig, runBright) where import Control.Exception (SomeException, handle) import qualified Data.ByteString.Lazy.Char8 as B import System.FilePath ((</>)) import System.Posix.Files (fileExist) import System.Console.GetOpt import Xmobar.Plugins.Monitors.Common data BrightOpts = BrightOpts { subDir :: String , currBright :: String , maxBright :: String , curBrightIconPattern :: Maybe IconPattern } defaultOpts :: BrightOpts defaultOpts = BrightOpts { subDir = "acpi_video0" , currBright = "actual_brightness" , maxBright = "max_brightness" , curBrightIconPattern = Nothing } options :: [OptDescr (BrightOpts -> BrightOpts)] options = [ Option "D" ["device"] (ReqArg (\x o -> o { subDir = x }) "") "" , Option "C" ["curr"] (ReqArg (\x o -> o { currBright = x }) "") "" , Option "M" ["max"] (ReqArg (\x o -> o { maxBright = x }) "") "" , Option "" ["brightness-icon-pattern"] (ReqArg (\x o -> o { curBrightIconPattern = Just $ parseIconPattern x }) "") "" ] sysDir :: FilePath sysDir = "/sys/class/backlight/" brightConfig :: IO MConfig brightConfig = mkMConfig "<percent>" -- template ["vbar", "percent", "bar", "ipat"] -- replacements 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 return (if is_curr && is_max then files else NoFiles) where prefix = sysDir </> subDir opts files = Files { fCurr = prefix </> currBright opts , fMax = prefix </> maxBright opts } runBright :: [String] -> Monitor String runBright args = do opts <- io $ parseOptsWith options defaultOpts args f <- io $ brightFiles opts c <- io $ readBright f case f of NoFiles -> return "hurz" _ -> fmtPercent opts c >>= parseTemplate where fmtPercent :: BrightOpts -> Float -> Monitor [String] fmtPercent opts c = do r <- showVerticalBar (100 * c) c s <- showPercentWithColors c t <- showPercentBar (100 * c) c d <- showIconPattern (curBrightIconPattern opts) c return [r,s,t,d] readBright :: Files -> IO Float readBright NoFiles = return 0 readBright files = do currVal<- grab $ fCurr files maxVal <- grab $ fMax files return (currVal / maxVal) where grab f = handle handler (read . B.unpack <$> B.readFile f) handler = const (return 0) :: SomeException -> IO Float �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/CatInt.hs���������������������������������������������������0000644�0000000�0000000�00000001376�07346545000�020123� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.CatInt -- Copyright : (c) Nathaniel Wesley Filardo -- License : BSD-style (see LICENSE) -- -- Maintainer : Nathaniel Wesley Filardo -- Stability : unstable -- Portability : unportable -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.CatInt where import Xmobar.Plugins.Monitors.Common catIntConfig :: IO MConfig catIntConfig = mkMConfig "<v>" ["v"] runCatInt :: FilePath -> [String] -> Monitor String runCatInt p _ = let failureMessage = "Cannot read: " ++ show p fmt x = show (truncate x :: Int) in checkedDataRetrieval failureMessage [[p]] Nothing id fmt ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Common.hs���������������������������������������������������0000644�0000000�0000000�00000002022�07346545000�020156� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Common -- Copyright : (c) 2010, 2011, 2013, 2016, 2017, 2018 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Utilities used by xmobar's monitors -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Common ( module Xmobar.Plugins.Monitors.Common.Types , module Xmobar.Plugins.Monitors.Common.Run , module Xmobar.Plugins.Monitors.Common.Output , module Xmobar.Plugins.Monitors.Common.Parsers , module Xmobar.Plugins.Monitors.Common.Files ) where import Xmobar.Plugins.Monitors.Common.Types import Xmobar.Plugins.Monitors.Common.Run import Xmobar.Plugins.Monitors.Common.Output import Xmobar.Plugins.Monitors.Common.Parsers import Xmobar.Plugins.Monitors.Common.Files ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Common/�����������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017626� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Common/Files.hs���������������������������������������������0000644�0000000�0000000�00000014230�07346545000�021224� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Files -- Copyright : (c) Juraj Hercek -- License : BSD-style (see LICENSE) -- -- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> -- Stability : unstable -- Portability : unportable -- -- Specialized helpers to access files and their contents -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Common.Files ( checkedDataRetrieval , checkedDataRead) where #if __GLASGOW_HASKELL__ < 800 import Control.Applicative #endif import Data.Char hiding (Space) import Data.Function import Data.List import Data.Maybe import System.Directory import Xmobar.Plugins.Monitors.Common.Types import Xmobar.Plugins.Monitors.Common.Parsers import Xmobar.Plugins.Monitors.Common.Output checkedDataRetrieval :: (Ord a, Num a) => String -> [[String]] -> Maybe (String, String -> Int) -> (Double -> a) -> (a -> String) -> Monitor String checkedDataRetrieval msg paths lbl trans fmt = fmap (fromMaybe msg . listToMaybe . catMaybes) $ mapM (\p -> retrieveData p lbl trans fmt) paths retrieveData :: (Ord a, Num a) => [String] -> Maybe (String, String -> Int) -> (Double -> a) -> (a -> String) -> Monitor (Maybe String) retrieveData path lbl trans fmt = do pairs <- map snd . sortBy (compare `on` fst) <$> (mapM readFiles =<< findFilesAndLabel path lbl) if null pairs then return Nothing else Just <$> ( parseTemplate =<< mapM (showWithColors fmt . trans . read) pairs ) checkedDataRead :: [[String]] -> Monitor [Double] checkedDataRead paths = concat <$> mapM readData paths where readData path = map (read . snd) . sortBy (compare `on` fst) <$> (mapM readFiles =<< findFilesAndLabel path Nothing) -- | Represents the different types of path components data Comp = Fix String | Var [String] deriving Show -- | Used to represent parts of file names separated by slashes and spaces data CompOrSep = Slash | Space | Comp String deriving (Eq, Show) -- | Function to turn a list of of strings into a list of path components pathComponents :: [String] -> [Comp] pathComponents = joinComps . drop 2 . intercalate [Space] . map splitParts where splitParts p | (l, _:r) <- break (== '/') p = Comp l : Slash : splitParts r | otherwise = [Comp p] joinComps = uncurry joinComps' . partition isComp isComp (Comp _) = True isComp _ = False fromComp (Comp s) = s fromComp _ = error "fromComp applied to value other than (Comp _)" joinComps' cs [] = [Fix $ fromComp $ head cs] -- cs should have only one element here, -- but this keeps the pattern matching -- exhaustive joinComps' cs (p:ps) = let (ss, ps') = span (== p) ps ct = if null ps' || (p == Space) then length ss + 1 else length ss (ls, rs) = splitAt (ct+1) cs c = case p of Space -> Var $ map fromComp ls Slash -> Fix $ intercalate "/" $ map fromComp ls _ -> error "Should not happen" in if null ps' then [c] else c:joinComps' rs (drop ct ps) -- | Function to find all files matching the given path and possible label file. -- The path must be absolute (start with a leading slash). findFilesAndLabel :: [String] -> Maybe (String, String -> Int) -> Monitor [(String, Either Int (String, String -> Int))] findFilesAndLabel path lbl = catMaybes <$> ( mapM addLabel . zip [0..] . sort =<< recFindFiles (pathComponents path) "/" ) where addLabel (i, f) = maybe (return $ Just (f, Left i)) (uncurry (justIfExists f)) lbl justIfExists f s t = let f' = take (length f - length s) f ++ s in ifthen (Just (f, Right (f', t))) Nothing <$> io (doesFileExist f') recFindFiles [] d = ifthen [d] [] <$> io (if null d then return False else doesFileExist d) recFindFiles ps d = ifthen (recFindFiles' ps d) (return []) =<< io (if null d then return True else doesDirectoryExist d) recFindFiles' [] _ = error "Should not happen" recFindFiles' (Fix p:ps) d = recFindFiles ps (d ++ "/" ++ p) recFindFiles' (Var p:ps) d = concat <$> ((mapM (recFindFiles ps . (\f -> d ++ "/" ++ f)) . filter (matchesVar p)) =<< io (getDirectoryContents d) ) matchesVar [] _ = False matchesVar [v] f = v == f matchesVar (v:vs) f = let f' = drop (length v) f f'' = dropWhile isDigit f' in and [ v `isPrefixOf` f , not (null f') , isDigit (head f') , matchesVar vs f'' ] -- | Function to read the contents of the given file(s) readFiles :: (String, Either Int (String, String -> Int)) -> Monitor (Int, String) readFiles (fval, flbl) = (,) <$> either return (\(f, ex) -> fmap ex $ io $ readFile f) flbl <*> io (readFile fval) -- | Function that captures if-then-else ifthen :: a -> a -> Bool -> a ifthen thn els cnd = if cnd then thn else els ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Common/Output.hs��������������������������������������������0000644�0000000�0000000�00000024342�07346545000�021467� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-#LANGUAGE RecordWildCards#-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Strings -- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Dec 02, 2018 04:25 -- -- -- Utilities for formatting monitor outputs -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Monitors.Common.Output ( IconPattern , parseIconPattern , padString , colorizeString , showWithPadding , showWithColors , showWithColors' , showPercentWithColors , showPercentsWithColors , showPercentBar , showVerticalBar , showIconPattern , showLogBar , showLogVBar , showLogIconPattern , showWithUnits , takeDigits , showDigits , floatToPercent , parseFloat , parseInt , stringParser , pShowPercentsWithColors , pShowPercentBar , pShowVerticalBar , pShowIconPattern , pShowPercentWithColors ) where import Data.Char import Data.List (intercalate, sort) import qualified Data.ByteString.Lazy.Char8 as B import Numeric import Control.Monad (zipWithM) import Control.Monad.IO.Class (MonadIO(..)) import Xmobar.Plugins.Monitors.Common.Types type IconPattern = Int -> String pShowVerticalBar :: (MonadIO m) => MonitorConfig -> Float -> Float -> m String pShowVerticalBar p v x = pColorizeString p v [convert $ 100 * x] where convert :: Float -> Char convert val | t <= 9600 = ' ' | t > 9608 = chr 9608 | otherwise = chr t where t = 9600 + (round val `div` 12) pShowPercentsWithColors :: (MonadIO m) => MonitorConfig -> [Float] -> m [String] pShowPercentsWithColors p fs = do let fstrs = map (pFloatToPercent p) fs temp = map (*100) fs zipWithM (pShowWithColors p . const) fstrs temp pShowPercentWithColors :: (MonadIO m) => MonitorConfig -> Float -> m String pShowPercentWithColors p f = fmap head $ pShowPercentsWithColors p [f] pShowPercentBar :: (MonadIO m) => MonitorConfig -> Float -> Float -> m String pShowPercentBar p@MonitorConfig{..} v x = do let len = min pBarWidth $ round (fromIntegral pBarWidth * x) s <- pColorizeString p v (take len $ cycle pBarFore) return $ s ++ take (pBarWidth - len) (cycle pBarBack) pShowWithColors :: (Num a, Ord a, MonadIO m) => MonitorConfig -> (a -> String) -> a -> m String pShowWithColors p f x = do let str = pShowWithPadding p (f x) pColorizeString p x str pColorizeString :: (Num a, Ord a, MonadIO m) => MonitorConfig -> a -> String -> m String pColorizeString p x s = do let col = pSetColor p s [ll,hh] = map fromIntegral $ sort [pLow p, pHigh p] -- consider high < low pure $ head $ [col pHighColor | x > hh ] ++ [col pNormalColor | x > ll ] ++ [col pLowColor | True] pSetColor :: MonitorConfig -> String -> PSelector (Maybe String) -> String pSetColor config str s = do let a = getPConfigValue config s case a of Nothing -> str Just c -> "<fc=" ++ c ++ ">" ++ str ++ "</fc>" pShowWithPadding :: MonitorConfig -> String -> String pShowWithPadding MonitorConfig {..} = padString pMinWidth pMaxWidth pPadChars pPadRight pMaxWidthEllipsis pFloatToPercent :: MonitorConfig -> Float -> String pFloatToPercent MonitorConfig{..} n = let p = showDigits 0 (n * 100) ps = if pUseSuffix then "%" else "" in padString pPpad pPpad pPadChars pPadRight "" p ++ ps parseIconPattern :: String -> IconPattern parseIconPattern path = let spl = splitOnPercent path in \i -> intercalate (show i) spl where splitOnPercent [] = [[]] splitOnPercent ('%':'%':xs) = [] : splitOnPercent xs splitOnPercent (x:xs) = let rest = splitOnPercent xs in (x : head rest) : tail rest type Pos = (Int, Int) takeDigits :: Int -> Float -> Float takeDigits d n = fromIntegral (round (n * fact) :: Int) / fact where fact = 10 ^ d showDigits :: (RealFloat a) => Int -> a -> String showDigits d n = showFFloat (Just d) n "" showWithUnits :: Int -> Int -> Float -> String showWithUnits d n x | x < 0 = '-' : showWithUnits d n (-x) | n > 3 || x < 10^(d + 1) = show (round x :: Int) ++ units n | x <= 1024 = showDigits d (x/1024) ++ units (n+1) | otherwise = showWithUnits d (n+1) (x/1024) where units = (!!) ["B", "K", "M", "G", "T"] padString :: Int -> Int -> String -> Bool -> String -> String -> String padString mnw mxw pad pr ellipsis s = let len = length s rmin = max mnw 0 rmax = if mxw <= 0 then max len rmin else mxw (rmn, rmx) = if rmin <= rmax then (rmin, rmax) else (rmax, rmin) rlen = min (max rmn len) rmx in if rlen < len then take rlen s ++ ellipsis else let ps = take (rlen - len) (cycle pad) in if pr then s ++ ps else ps ++ s parseFloat :: String -> Float parseFloat s = case readFloat s of (v, _):_ -> v _ -> 0 parseInt :: String -> Int parseInt s = case readDec s of (v, _):_ -> v _ -> 0 floatToPercent :: Float -> Monitor String floatToPercent n = do pad <- getConfigValue ppad pc <- getConfigValue padChars pr <- getConfigValue padRight up <- getConfigValue useSuffix let p = showDigits 0 (n * 100) ps = if up then "%" else "" return $ padString pad pad pc pr "" p ++ ps stringParser :: Pos -> B.ByteString -> String stringParser (x,y) = B.unpack . li x . B.words . li y . B.lines where li i l | length l > i = l !! i | otherwise = B.empty setColor :: String -> Selector (Maybe String) -> Monitor String setColor str s = do a <- getConfigValue s case a of Nothing -> return str Just c -> return $ "<fc=" ++ c ++ ">" ++ str ++ "</fc>" showWithPadding :: String -> Monitor String showWithPadding s = do mn <- getConfigValue minWidth mx <- getConfigValue maxWidth p <- getConfigValue padChars pr <- getConfigValue padRight ellipsis <- getConfigValue maxWidthEllipsis return $ padString mn mx p pr ellipsis s colorizeString :: (Num a, Ord a) => a -> String -> Monitor String colorizeString x s = do h <- getConfigValue high l <- getConfigValue low let col = setColor s [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low head $ [col highColor | x > hh ] ++ [col normalColor | x > ll ] ++ [col lowColor | True] showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String showWithColors f x = showWithPadding (f x) >>= colorizeString x showWithColors' :: (Num a, Ord a) => String -> a -> Monitor String showWithColors' str = showWithColors (const str) showPercentsWithColors :: [Float] -> Monitor [String] showPercentsWithColors fs = do fstrs <- mapM floatToPercent fs zipWithM (showWithColors . const) fstrs (map (*100) fs) showPercentWithColors :: Float -> Monitor String showPercentWithColors f = fmap head $ showPercentsWithColors [f] showPercentBar :: Float -> Float -> Monitor String showPercentBar v x = do bb <- getConfigValue barBack bf <- getConfigValue barFore bw <- getConfigValue barWidth let c = bw < 1 w = if c then length bf else bw len = min w $ (if c then ceiling else round) (fromIntegral w * x) bfs = if c then [bf !! max 0 (len - 1)] else take len $ cycle bf s <- colorizeString v bfs return $ s ++ if c then "" else take (bw - len) (cycle bb) showIconPattern :: Maybe IconPattern -> Float -> Monitor String showIconPattern Nothing _ = return "" showIconPattern (Just str) x = return $ str $ convert $ 100 * x where convert val | t <= 0 = 0 | t > 8 = 8 | otherwise = t where t = round val `div` 12 pShowIconPattern :: Maybe IconPattern -> Float -> IO String pShowIconPattern Nothing _ = return "" pShowIconPattern (Just str) x = return $ str $ convert $ 100 * x where convert val | t <= 0 = 0 | t > 8 = 8 | otherwise = t where t = round val `div` 12 showVerticalBar :: Float -> Float -> Monitor String showVerticalBar v x = colorizeString v [convert $ 100 * x] where convert :: Float -> Char convert val | t <= 9600 = ' ' | t > 9608 = chr 9608 | otherwise = chr t where t = 9600 + (round val `div` 12) logScaling :: Float -> Float -> Monitor Float logScaling f v = do h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth let [ll, hh] = sort [l, h] bw' = if bw > 0 then bw else 10 scaled x | x == 0.0 = 0 | x <= ll = 1 / bw' | otherwise = f + logBase 2 (x / hh) / bw' return $ scaled v showLogBar :: Float -> Float -> Monitor String showLogBar f v = logScaling f v >>= showPercentBar v showLogVBar :: Float -> Float -> Monitor String showLogVBar f v = logScaling f v >>= showVerticalBar v showLogIconPattern :: Maybe IconPattern -> Float -> Float -> Monitor String showLogIconPattern str f v = logScaling f v >>= showIconPattern str ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Common/Parsers.hs�������������������������������������������0000644�0000000�0000000�00000016552�07346545000�021612� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-#LANGUAGE RecordWildCards#-} {-#LANGUAGE ScopedTypeVariables#-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Parsers -- Copyright: (c) 2018, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Dec 02, 2018 04:49 -- -- -- Parsing template strings -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Monitors.Common.Parsers ( runP , skipRestOfLine , getNumbers , getNumbersAsString , getAllBut , getAfterString , skipTillString , parseTemplate , parseTemplate' , parseOptsWith , templateParser , runExportParser , runTemplateParser , pureParseTemplate ) where import Xmobar.Plugins.Monitors.Common.Types import qualified Data.Map as Map import System.Console.GetOpt (ArgOrder(Permute), OptDescr, getOpt) import Text.ParserCombinators.Parsec runTemplateParser :: MonitorConfig -> IO [(String, String, String)] runTemplateParser MonitorConfig{..} = runP templateParser pTemplate runExportParser :: [String] -> IO [(String, [(String, String,String)])] runExportParser [] = pure [] runExportParser (x:xs) = do s <- runP templateParser x rest <- runExportParser xs pure $ (x,s):rest pureParseTemplate :: MonitorConfig -> TemplateInput -> IO String pureParseTemplate MonitorConfig{..} TemplateInput{..} = do let m = let expSnds :: [([(String, String, String)], String)] = zip (map snd temAllTemplate) temMonitorValues in Map.fromList $ zip (map fst temAllTemplate) expSnds s <- minCombine m temInputTemplate let (n, s') = if pMaxTotalWidth > 0 && length s > pMaxTotalWidth then trimTo (pMaxTotalWidth - length pMaxTotalWidthEllipsis) "" s else (1, s) return $ if n > 0 then s' else s' ++ pMaxTotalWidthEllipsis minCombine :: Map.Map String ([(String, String, String)], String) -> [(String, String, String)] -> IO String minCombine _ [] = return [] minCombine m ((s,ts,ss):xs) = do next <- minCombine m xs str <- case Map.lookup ts m of Nothing -> return $ "<" ++ ts ++ ">" Just (s',r) -> let f "" = r; f n = n; in f <$> minCombine m s' pure $ s ++ str ++ ss ++ next runP :: Parser [a] -> String -> IO [a] runP p i = case parse p "" i of Left _ -> return [] Right x -> return x getAllBut :: String -> Parser String getAllBut s = manyTill (noneOf s) (char $ head s) getNumbers :: Parser Float getNumbers = skipMany space >> many1 digit >>= \n -> return $ read n getNumbersAsString :: Parser String getNumbersAsString = skipMany space >> many1 digit >>= \n -> return n skipRestOfLine :: Parser Char skipRestOfLine = do many $ noneOf "\n\r" newline getAfterString :: String -> Parser String getAfterString s = do { try $ manyTill skipRestOfLine $ string s ; manyTill anyChar newline } <|> return "" skipTillString :: String -> Parser String skipTillString s = manyTill skipRestOfLine $ string s -- | Parses the output template string templateStringParser :: Parser (String,String,String) templateStringParser = do { s <- nonPlaceHolder ; com <- templateCommandParser ; ss <- nonPlaceHolder ; return (s, com, ss) } where nonPlaceHolder = fmap concat . many $ many1 (noneOf "<") <|> colorSpec <|> iconSpec -- | Recognizes color specification and returns it unchanged colorSpec :: Parser String colorSpec = try (string "</fc>") <|> try ( do string "<fc=" s <- many1 (alphaNum <|> char ',' <|> char '#') char '>' return $ "<fc=" ++ s ++ ">") -- | Recognizes icon specification and returns it unchanged iconSpec :: Parser String iconSpec = try (do string "<icon=" i <- manyTill (noneOf ">") (try (string "/>")) return $ "<icon=" ++ i ++ "/>") -- | Parses the command part of the template string templateCommandParser :: Parser String templateCommandParser = do { char '<' ; com <- many $ noneOf ">" ; char '>' ; return com } -- | Combines the template parsers templateParser :: Parser [(String,String,String)] templateParser = many templateStringParser --"%") trimTo :: Int -> String -> String -> (Int, String) trimTo n p "" = (n, p) trimTo n p ('<':cs) = trimTo n p' s where p' = p ++ "<" ++ takeWhile (/= '>') cs ++ ">" s = drop 1 (dropWhile (/= '>') cs) trimTo 0 p s = trimTo 0 p (dropWhile (/= '<') s) trimTo n p s = let p' = takeWhile (/= '<') s s' = dropWhile (/= '<') s in if length p' <= n then trimTo (n - length p') (p ++ p') s' else trimTo 0 (p ++ take n p') s' -- | Takes a list of strings that represent the values of the exported -- keys. The strings are joined with the exported keys to form a map -- to be combined with 'combine' to the parsed template. Returns the -- final output of the monitor, trimmed to MaxTotalWidth if that -- configuration value is positive. parseTemplate :: [String] -> Monitor String parseTemplate l = do t <- getConfigValue template e <- getConfigValue export w <- getConfigValue maxTotalWidth ell <- getConfigValue maxTotalWidthEllipsis let m = Map.fromList . zip e $ l s <- parseTemplate' t m let (n, s') = if w > 0 && length s > w then trimTo (w - length ell) "" s else (1, s) return $ if n > 0 then s' else s' ++ ell -- | Parses the template given to it with a map of export values and combines -- them parseTemplate' :: String -> Map.Map String String -> Monitor String parseTemplate' t m = do s <- io $ runP templateParser t combine m s -- | Given a finite "Map" and a parsed template t produces the -- | resulting output string as the output of the monitor. combine :: Map.Map String String -> [(String, String, String)] -> Monitor String combine _ [] = return [] combine m ((s,ts,ss):xs) = do next <- combine m xs str <- case Map.lookup ts m of Nothing -> return $ "<" ++ ts ++ ">" Just r -> let f "" = r; f n = n; in f <$> parseTemplate' r m return $ s ++ str ++ ss ++ next -- | Try to parse arguments from the config file and apply them to Options. parseOptsWith :: [OptDescr (opts -> opts)] -- ^ Options that are specifiable -> opts -- ^ Default options to use as a fallback -> [String] -- ^ Actual arguments given -> IO opts parseOptsWith options defaultOpts argv = case getOpt Permute options argv of (o, _, [] ) -> pure $ foldr id defaultOpts o (_, _, errs) -> ioError . userError $ concat errs ������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Common/Run.hs�����������������������������������������������0000644�0000000�0000000�00000017351�07346545000�020735� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Run -- Copyright: (c) 2018 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Dec 02, 2018 04:17 -- -- -- Running a monitor -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Monitors.Common.Run ( runM , runMD , runMB , runMBD , runML , runMLD , getArgvs , doArgs , computeMonitorConfig , pluginOptions ) where import Control.Exception (SomeException,handle) import Data.List import Control.Monad.Reader import System.Console.GetOpt import Xmobar.Plugins.Monitors.Common.Types import Xmobar.Run.Exec (doEveryTenthSeconds) pluginOptions :: [OptDescr Opts] pluginOptions = [ Option ['H'] ["High"] (ReqArg High "number") "The high threshold" , Option ['L'] ["Low"] (ReqArg Low "number") "The low threshold" , Option "h" ["high"] (ReqArg HighColor "color number") "Color for the high threshold: ex \"#FF0000\"" , Option "n" ["normal"] (ReqArg NormalColor "color number") "Color for the normal threshold: ex \"#00FF00\"" , Option "l" ["low"] (ReqArg LowColor "color number") "Color for the low threshold: ex \"#0000FF\"" , Option "t" ["template"] (ReqArg Template "output template") "Output template." , Option "S" ["suffix"] (ReqArg UseSuffix "True/False") "Use % to display percents or other suffixes." , Option "d" ["ddigits"] (ReqArg DecDigits "decimal digits") "Number of decimal digits to display." , Option "p" ["ppad"] (ReqArg PercentPad "percent padding") "Minimum percentage width." , Option "m" ["minwidth"] (ReqArg MinWidth "minimum width") "Minimum field width" , Option "M" ["maxwidth"] (ReqArg MaxWidth "maximum width") "Maximum field width" , Option "w" ["width"] (ReqArg Width "fixed width") "Fixed field width" , Option "e" ["maxwidthellipsis"] (ReqArg WidthEllipsis "Maximum width ellipsis") "Ellipsis to be added to the field when it has reached its max width." , Option "c" ["padchars"] (ReqArg PadChars "padding chars") "Characters to use for padding" , Option "a" ["align"] (ReqArg PadAlign "padding alignment") "'l' for left padding, 'r' for right" , Option "b" ["bback"] (ReqArg BarBack "bar background") "Characters used to draw bar backgrounds" , Option "f" ["bfore"] (ReqArg BarFore "bar foreground") "Characters used to draw bar foregrounds" , Option "W" ["bwidth"] (ReqArg BarWidth "bar width") "Bar width" , Option "x" ["nastring"] (ReqArg NAString "N/A string") "String used when the monitor is not available" , Option "T" ["maxtwidth"] (ReqArg MaxTotalWidth "Maximum total width") "Maximum total width" , Option "E" ["maxtwidthellipsis"] (ReqArg MaxTotalWidthEllipsis "Maximum total width ellipsis") "Ellipsis to be added to the total text when it has reached its max width." ] -- | Get all argument values out of a list of arguments. getArgvs :: [String] -> [String] getArgvs args = case getOpt Permute pluginOptions args of (_, n, [] ) -> n (_, _, errs) -> errs doArgs :: [String] -> ([String] -> Monitor String) -> ([String] -> Monitor Bool) -> Monitor String doArgs args action detect = case getOpt Permute pluginOptions args of (o, n, []) -> do doConfigOptions o ready <- detect n if ready then action n else return "<Waiting...>" (_, _, errs) -> return (concat errs) doConfigOptions :: [Opts] -> Monitor () doConfigOptions [] = io $ return () doConfigOptions (o:oo) = do let next = doConfigOptions oo nz s = let x = read s in max 0 x bool = (`elem` ["True", "true", "Yes", "yes", "On", "on"]) (case o of High h -> setConfigValue (read h) high Low l -> setConfigValue (read l) low HighColor c -> setConfigValue (Just c) highColor NormalColor c -> setConfigValue (Just c) normalColor LowColor c -> setConfigValue (Just c) lowColor Template t -> setConfigValue t template PercentPad p -> setConfigValue (nz p) ppad DecDigits d -> setConfigValue (nz d) decDigits MinWidth w -> setConfigValue (nz w) minWidth MaxWidth w -> setConfigValue (nz w) maxWidth Width w -> setConfigValue (nz w) minWidth >> setConfigValue (nz w) maxWidth WidthEllipsis e -> setConfigValue e maxWidthEllipsis PadChars s -> setConfigValue s padChars PadAlign a -> setConfigValue ("r" `isPrefixOf` a) padRight BarBack s -> setConfigValue s barBack BarFore s -> setConfigValue s barFore BarWidth w -> setConfigValue (nz w) barWidth UseSuffix u -> setConfigValue (bool u) useSuffix NAString s -> setConfigValue s naString MaxTotalWidth w -> setConfigValue (nz w) maxTotalWidth MaxTotalWidthEllipsis e -> setConfigValue e maxTotalWidthEllipsis) >> next runM :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int -> (String -> IO ()) -> IO () runM args conf action r = runML args conf action (doEveryTenthSeconds r) runMD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> Int -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () runMD args conf action r = runMLD args conf action (doEveryTenthSeconds r) runMB :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO () -> (String -> IO ()) -> IO () runMB args conf action wait = runMBD args conf action wait (\_ -> return True) runMBD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> IO () -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () runMBD args conf action wait detect cb = handle (cb . showException) loop where ac = doArgs args action detect loop = conf >>= runReaderT ac >>= cb >> wait >> loop runML :: [String] -> IO MConfig -> ([String] -> Monitor String) -> (IO () -> IO ()) -> (String -> IO ()) -> IO () runML args conf action looper = runMLD args conf action looper (\_ -> return True) runMLD :: [String] -> IO MConfig -> ([String] -> Monitor String) -> (IO () -> IO ()) -> ([String] -> Monitor Bool) -> (String -> IO ()) -> IO () runMLD args conf action looper detect cb = handle (cb . showException) loop where ac = doArgs args action detect loop = looper $ conf >>= runReaderT ac >>= cb showException :: SomeException -> String showException = ("error: "++) . show . flip asTypeOf undefined computeMonitorConfig :: [String] -> IO MConfig -> IO MonitorConfig computeMonitorConfig args mconfig = do newConfig <- getMConfig args mconfig getMonitorConfig newConfig getMConfig :: [String] -> IO MConfig -> IO MConfig getMConfig args mconfig = do config <- mconfig runReaderT (updateOptions args >> ask) config updateOptions :: [String] -> Monitor () updateOptions args= case getOpt Permute pluginOptions args of (o, _, []) -> doConfigOptions o _ -> return () ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Common/Types.hs���������������������������������������������0000644�0000000�0000000�00000013401�07346545000�021265� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-#LANGUAGE RecordWildCards#-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Types -- Copyright: (c) 2018 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Dec 02, 2018 04:31 -- -- -- Type definitions and constructors for Monitors -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Monitors.Common.Types ( Monitor , MConfig (..) , Opts (..) , Selector , setConfigValue , mkMConfig , io , MonitorConfig (..) , getPConfigValue , getConfigValue , getMonitorConfig , PSelector , TemplateInput(..) ) where import Control.Monad.Reader (ReaderT, ask, liftIO) import Data.IORef (IORef, modifyIORef, newIORef, readIORef) type Monitor a = ReaderT MConfig IO a io :: IO a -> Monitor a io = liftIO data TemplateInput = TemplateInput { temMonitorValues :: [String], temInputTemplate :: [(String, String, String)], temAllTemplate :: [(String, [(String, String, String)])] } data MConfig = MC { normalColor :: IORef (Maybe String) , low :: IORef Int , lowColor :: IORef (Maybe String) , high :: IORef Int , highColor :: IORef (Maybe String) , template :: IORef String , export :: IORef [String] , ppad :: IORef Int , decDigits :: IORef Int , minWidth :: IORef Int , maxWidth :: IORef Int , maxWidthEllipsis :: IORef String , padChars :: IORef String , padRight :: IORef Bool , barBack :: IORef String , barFore :: IORef String , barWidth :: IORef Int , useSuffix :: IORef Bool , naString :: IORef String , maxTotalWidth :: IORef Int , maxTotalWidthEllipsis :: IORef String } data MonitorConfig = MonitorConfig { pNormalColor :: Maybe String , pLow :: Int , pLowColor :: Maybe String , pHigh :: Int , pHighColor :: Maybe String , pTemplate :: String , pExport :: [String] , pPpad :: Int , pDecDigits :: Int , pMinWidth :: Int , pMaxWidth :: Int , pMaxWidthEllipsis :: String , pPadChars :: String , pPadRight :: Bool , pBarBack :: String , pBarFore :: String , pBarWidth :: Int , pUseSuffix :: Bool , pNaString :: String , pMaxTotalWidth :: Int , pMaxTotalWidthEllipsis :: String } deriving (Eq, Ord) getMonitorConfig :: MConfig -> IO MonitorConfig getMonitorConfig MC{..} = do pNormalColor <- readIORef normalColor pLow <- readIORef low pLowColor <- readIORef lowColor pHigh <- readIORef high pHighColor <- readIORef highColor pTemplate <- readIORef template pExport <- readIORef export pPpad <- readIORef ppad pDecDigits <- readIORef decDigits pMinWidth <- readIORef minWidth pMaxWidth <- readIORef maxWidth pMaxWidthEllipsis <- readIORef maxWidthEllipsis pPadChars <- readIORef padChars pPadRight <- readIORef padRight pBarBack <- readIORef barBack pBarFore <- readIORef barFore pBarWidth <- readIORef barWidth pUseSuffix <- readIORef useSuffix pNaString <- readIORef naString pMaxTotalWidth <- readIORef maxTotalWidth pMaxTotalWidthEllipsis <- readIORef maxTotalWidthEllipsis pure $ MonitorConfig {..} -- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' type Selector a = MConfig -> IORef a type PSelector a = MonitorConfig -> a psel :: MonitorConfig -> PSelector a -> a psel value accessor = accessor value sel :: Selector a -> Monitor a sel s = do hs <- ask liftIO $ readIORef (s hs) mods :: Selector a -> (a -> a) -> Monitor () mods s m = do v <- ask io $ modifyIORef (s v) m setConfigValue :: a -> Selector a -> Monitor () setConfigValue v s = mods s (const v) getConfigValue :: Selector a -> Monitor a getConfigValue = sel getPConfigValue :: MonitorConfig -> PSelector a -> a getPConfigValue = psel mkMConfig :: String -> [String] -> IO MConfig mkMConfig tmpl exprts = do lc <- newIORef Nothing l <- newIORef 33 nc <- newIORef Nothing h <- newIORef 66 hc <- newIORef Nothing t <- newIORef tmpl e <- newIORef exprts p <- newIORef 0 d <- newIORef 0 mn <- newIORef 0 mx <- newIORef 0 mel <- newIORef "" pc <- newIORef " " pr <- newIORef False bb <- newIORef ":" bf <- newIORef "#" bw <- newIORef 10 up <- newIORef False na <- newIORef "N/A" mt <- newIORef 0 mtel <- newIORef "" return $ MC nc l lc h hc t e p d mn mx mel pc pr bb bf bw up na mt mtel data Opts = HighColor String | NormalColor String | LowColor String | Low String | High String | Template String | PercentPad String | DecDigits String | MinWidth String | MaxWidth String | Width String | WidthEllipsis String | PadChars String | PadAlign String | BarBack String | BarFore String | BarWidth String | UseSuffix String | NAString String | MaxTotalWidth String | MaxTotalWidthEllipsis String ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/CoreTemp.hs�������������������������������������������������0000644�0000000�0000000�00000002742�07346545000�020455� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.CoreTemp -- Copyright : (c) Juraj Hercek -- License : BSD-style (see LICENSE) -- -- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> -- Stability : unstable -- Portability : unportable -- -- A core temperature monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.CoreTemp where import Xmobar.Plugins.Monitors.Common import Data.Char (isDigit) -- | -- Core temperature default configuration. Default template contains only one -- core temperature, user should specify custom template in order to get more -- core frequencies. coreTempConfig :: IO MConfig coreTempConfig = mkMConfig "Temp: <core0>C" -- template (map ((++) "core" . show) [0 :: Int ..]) -- available replacements -- | -- Function retrieves monitor string holding the core temperature -- (or temperatures) runCoreTemp :: [String] -> Monitor String runCoreTemp _ = do dn <- getConfigValue decDigits failureMessage <- getConfigValue naString let path = ["/sys/bus/platform/devices/coretemp.", "/temp", "_input"] path' = ["/sys/bus/platform/devices/coretemp.", "/hwmon/hwmon", "/temp", "_input"] lbl = Just ("_label", read . dropWhile (not . isDigit)) divisor = 1e3 :: Double show' = showDigits (max 0 dn) checkedDataRetrieval failureMessage [path, path'] lbl (/divisor) show' ������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Cpu.hs������������������������������������������������������0000644�0000000�0000000�00000013552�07346545000�017467� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-#LANGUAGE CPP #-} {-#LANGUAGE RecordWildCards#-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Cpu -- Copyright : (c) 2011, 2017, 2022 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A cpu monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Cpu ( startCpu , runCpu , cpuConfig , MC.CpuDataRef , CpuOpts , CpuArguments , MC.parseCpu , getArguments ) where import Xmobar.Plugins.Monitors.Common import Data.IORef (newIORef) import System.Console.GetOpt import Xmobar.Run.Timer (doEveryTenthSeconds) import Control.Monad (void) import Xmobar.Plugins.Monitors.Cpu.Common (CpuData(..)) #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Cpu.FreeBSD as MC #else import qualified Xmobar.Plugins.Monitors.Cpu.Linux as MC #endif newtype CpuOpts = CpuOpts { loadIconPattern :: Maybe IconPattern } defaultOpts :: CpuOpts defaultOpts = CpuOpts { loadIconPattern = Nothing } options :: [OptDescr (CpuOpts -> CpuOpts)] options = [ Option "" ["load-icon-pattern"] (ReqArg (\x o -> o { loadIconPattern = Just $ parseIconPattern x }) "") "" ] barField :: String barField = "bar" vbarField :: String vbarField = "vbar" ipatField :: String ipatField = "ipat" totalField :: String totalField = "total" userField :: String userField = "user" niceField :: String niceField = "nice" systemField :: String systemField = "system" idleField :: String idleField = "idle" iowaitField :: String iowaitField = "iowait" cpuConfig :: IO MConfig cpuConfig = mkMConfig "Cpu: <total>%" [ barField , vbarField , ipatField , totalField , userField , niceField , systemField , idleField , iowaitField ] data Field = Field { fieldName :: !String, fieldCompute :: !ShouldCompute } deriving (Eq, Ord, Show) data ShouldCompute = Compute | Skip deriving (Eq, Ord, Show) formatField :: MonitorConfig -> CpuOpts -> CpuData -> Field -> IO String formatField cpuParams cpuOpts cpuInfo@CpuData {..} Field {..} | fieldName == barField = if fieldCompute == Compute then pShowPercentBar cpuParams (100 * cpuTotal) cpuTotal else pure [] | fieldName == vbarField = if fieldCompute == Compute then pShowVerticalBar cpuParams (100 * cpuTotal) cpuTotal else pure [] | fieldName == ipatField = if fieldCompute == Compute then pShowIconPattern (loadIconPattern cpuOpts) cpuTotal else pure [] | otherwise = if fieldCompute == Compute then pShowPercentWithColors cpuParams (getFieldValue fieldName cpuInfo) else pure [] getFieldValue :: String -> CpuData -> Float getFieldValue field CpuData{..} | field == barField = cpuTotal | field == vbarField = cpuTotal | field == ipatField = cpuTotal | field == totalField = cpuTotal | field == userField = cpuUser | field == niceField = cpuNice | field == systemField = cpuSystem | field == idleField = cpuIdle | otherwise = cpuIowait computeFields :: [String] -> [String] -> [Field] computeFields [] _ = [] computeFields (x:xs) inputFields = if x `elem` inputFields then (Field {fieldName = x, fieldCompute = Compute}) : computeFields xs inputFields else (Field {fieldName = x, fieldCompute = Skip}) : computeFields xs inputFields formatCpu :: CpuArguments -> CpuData -> IO [String] formatCpu CpuArguments{..} cpuInfo = do strs <- mapM (formatField cpuParams cpuOpts cpuInfo) cpuFields pure $ filter (not . null) strs getInputFields :: CpuArguments -> [String] getInputFields CpuArguments{..} = map (\(_,f,_) -> f) cpuInputTemplate optimizeAllTemplate :: CpuArguments -> CpuArguments optimizeAllTemplate args@CpuArguments {..} = let inputFields = getInputFields args allTemplates = filter (\(field, _) -> field `elem` inputFields) cpuAllTemplate in args {cpuAllTemplate = allTemplates} data CpuArguments = CpuArguments { cpuDataRef :: !MC.CpuDataRef , cpuParams :: !MonitorConfig , cpuArgs :: ![String] , cpuOpts :: !CpuOpts , cpuInputTemplate :: ![(String, String, String)] -- [("Cpu: ","total","% "),("","user","%")] , cpuAllTemplate :: ![(String, [(String, String, String)])] -- [("bar",[]),("vbar",[]),("ipat",[]),("total",[]),...] , cpuFields :: ![Field] } getArguments :: [String] -> IO CpuArguments getArguments cpuArgs = do initCpuData <- MC.cpuData cpuDataRef <- newIORef initCpuData void $ MC.parseCpu cpuDataRef cpuParams <- computeMonitorConfig cpuArgs cpuConfig cpuInputTemplate <- runTemplateParser cpuParams cpuAllTemplate <- runExportParser (pExport cpuParams) nonOptions <- case getOpt Permute pluginOptions cpuArgs of (_, n, []) -> pure n (_, _, errs) -> error $ "getArguments: " <> show errs cpuOpts <- case getOpt Permute options nonOptions of (o, _, []) -> pure $ foldr id defaultOpts o (_, _, errs) -> error $ "getArguments options: " <> show errs let cpuFields = computeFields (map fst cpuAllTemplate) (map (\(_, f, _) -> f) cpuInputTemplate) pure $ optimizeAllTemplate CpuArguments {..} runCpu :: CpuArguments -> IO String runCpu args@CpuArguments {..} = do cpuValue <- MC.parseCpu cpuDataRef temMonitorValues <- formatCpu args cpuValue let templateInput = TemplateInput { temInputTemplate = cpuInputTemplate , temAllTemplate = cpuAllTemplate , .. } pureParseTemplate cpuParams templateInput startCpu :: [String] -> Int -> (String -> IO ()) -> IO () startCpu args refreshRate cb = do cpuArgs <- getArguments args doEveryTenthSeconds refreshRate (runCpu cpuArgs >>= cb) ������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Cpu/��������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017125� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Cpu/Common.hs�����������������������������������������������0000644�0000000�0000000�00000001354�07346545000�020714� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Cpu.Common -- Copyright : (c) 2011, 2017 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A cpu monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Cpu.Common (CpuData(..)) where data CpuData = CpuData { cpuUser :: !Float, cpuNice :: !Float, cpuSystem :: !Float, cpuIdle :: !Float, cpuIowait :: !Float, cpuTotal :: !Float } ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Cpu/FreeBSD.hs����������������������������������������������0000644�0000000�0000000�00000003446�07346545000�020702� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Cpu.FreeBSD -- Copyright : (c) 2011, 2017 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A cpu monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Cpu.FreeBSD (parseCpu , CpuDataRef , cpuData) where import Xmobar.Plugins.Monitors.Cpu.Common (CpuData(..)) import Data.IORef (IORef, readIORef, writeIORef) import System.BSD.Sysctl (sysctlPeekArray) -- kern.cp_time data from the previous iteration for computing the difference type CpuDataRef = IORef [Word] cpuData :: IO [Word] cpuData = sysctlPeekArray "kern.cp_time" :: IO [Word] parseCpu :: CpuDataRef -> IO CpuData parseCpu cref = do prev <- readIORef cref curr <- cpuData writeIORef cref curr let diff = map fromIntegral $ zipWith (-) curr prev user = head diff nice = diff !! 1 system = diff !! 2 intr = diff !! 3 idle = diff !! 4 total = user + nice + system + intr + idle cpuUserPerc = if total > 0 then user/total else 0 cpuNicePerc = if total > 0 then nice/total else 0 cpuSystemPerc = if total > 0 then (system+intr)/total else 0 cpuIdlePerc = if total > 0 then idle/total else 0 return CpuData { cpuUser = cpuUserPerc , cpuNice = cpuNicePerc , cpuSystem = cpuSystemPerc , cpuIdle = cpuIdlePerc , cpuIowait = 0 , cpuTotal = cpuUserPerc+cpuSystemPerc } ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Cpu/Linux.hs������������������������������������������������0000644�0000000�0000000�00000003605�07346545000�020564� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Cpu.Linux -- Copyright : (c) 2011, 2017 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A cpu monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Cpu.Linux (parseCpu , CpuDataRef , cpuData) where import Xmobar.Plugins.Monitors.Cpu.Common (CpuData(..)) import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef (IORef, readIORef, writeIORef) type CpuDataRef = IORef [Int] -- Details about the fields here: https://www.kernel.org/doc/Documentation/filesystems/proc.txt cpuData :: IO [Int] cpuData = cpuParser <$> B.readFile "/proc/stat" readInt :: B.ByteString -> Int readInt bs = case B.readInt bs of Nothing -> 0 Just (i, _) -> i cpuParser :: B.ByteString -> [Int] cpuParser = map readInt . tail . B.words . head . B.lines convertToCpuData :: [Float] -> CpuData convertToCpuData (u:n:s:ie:iw:_) = CpuData { cpuUser = u , cpuNice = n , cpuSystem = s , cpuIdle = ie , cpuIowait = iw , cpuTotal = sum [u, n, s] } convertToCpuData args = error $ "convertToCpuData: Unexpected list" <> show args parseCpu :: CpuDataRef -> IO CpuData parseCpu cref = do a <- readIORef cref b <- cpuData writeIORef cref b let dif = zipWith (-) b a tot = fromIntegral $ sum dif safeDiv n = case tot of 0 -> 0 v -> fromIntegral n / v percent = map safeDiv dif return $ convertToCpuData percent ���������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/CpuFreq.hs��������������������������������������������������0000644�0000000�0000000�00000003172�07346545000�020302� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.CpuFreq -- Copyright : (c) Juraj Hercek -- License : BSD-style (see LICENSE) -- -- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> -- Stability : unstable -- Portability : unportable -- -- A cpu frequency monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.CpuFreq where import Xmobar.Plugins.Monitors.Common -- | -- Cpu frequency default configuration. Default template contains only -- one core frequency, user should specify custom template in order to -- get more cpu frequencies. cpuFreqConfig :: IO MConfig cpuFreqConfig = mkMConfig "Freq: <cpu0>" (["max", "min", "avg"] ++ map ((++) "cpu" . show) [0 :: Int ..]) -- | -- Function retrieves monitor string holding the cpu frequency (or -- frequencies) runCpuFreq :: [String] -> Monitor String runCpuFreq _ = do suffix <- getConfigValue useSuffix ddigits <- getConfigValue decDigits let paths = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"] divisor = 1e6 :: Double fmt x | x < 1 = if suffix then mhzFmt x ++ "MHz" else ghzFmt x | otherwise = ghzFmt x ++ if suffix then "GHz" else "" mhzFmt x = show (round (x * 1000) :: Integer) ghzFmt = showDigits ddigits sts xs = [maximum xs, minimum xs, sum xs / fromIntegral (length xs)] vs <- checkedDataRead [paths] if null vs then getConfigValue naString else mapM (showWithColors fmt . (/divisor)) (sts vs ++ vs) >>= parseTemplate ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Disk.hs�����������������������������������������������������0000644�0000000�0000000�00000014163�07346545000�017631� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk -- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Disk usage and throughput monitors for Xmobar -- ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} module Xmobar.Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where import Xmobar.Plugins.Monitors.Common #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Disk.FreeBSD as MD #else import qualified Xmobar.Plugins.Monitors.Disk.Linux as MD #endif import Control.Monad (zipWithM) import System.Console.GetOpt import Data.List (find) import Xmobar.Plugins.Monitors.Disk.Common ( DevName , Path ) data DiskIOOpts = DiskIOOpts { totalIconPattern :: Maybe IconPattern , writeIconPattern :: Maybe IconPattern , readIconPattern :: Maybe IconPattern , contiguous :: Bool } dioDefaultOpts :: DiskIOOpts dioDefaultOpts = DiskIOOpts { totalIconPattern = Nothing , writeIconPattern = Nothing , readIconPattern = Nothing , contiguous = False } dioOptions :: [OptDescr (DiskIOOpts -> DiskIOOpts)] dioOptions = [ Option "" ["total-icon-pattern"] (ReqArg (\x o -> o { totalIconPattern = Just $ parseIconPattern x}) "") "" , Option "" ["write-icon-pattern"] (ReqArg (\x o -> o { writeIconPattern = Just $ parseIconPattern x}) "") "" , Option "" ["read-icon-pattern"] (ReqArg (\x o -> o { readIconPattern = Just $ parseIconPattern x}) "") "" , Option "c" ["contiguous"] (NoArg (\o -> o {contiguous = True})) "" ] diskIOConfig :: IO MConfig diskIOConfig = mkMConfig "" ["total", "read", "write" ,"totalb", "readb", "writeb" ,"totalbar", "readbar", "writebar" ,"totalbbar", "readbbar", "writebbar" ,"totalvbar", "readvbar", "writevbar" ,"totalbvbar", "readbvbar", "writebvbar" ,"totalipat", "readipat", "writeipat" ,"totalbipat", "readbipat", "writebipat" ] data DiskUOpts = DiskUOpts { freeIconPattern :: Maybe IconPattern , usedIconPattern :: Maybe IconPattern , contiguousU :: Bool } duDefaultOpts :: DiskUOpts duDefaultOpts = DiskUOpts { freeIconPattern = Nothing , usedIconPattern = Nothing , contiguousU = False } duOptions :: [OptDescr (DiskUOpts -> DiskUOpts)] duOptions = [ Option "" ["free-icon-pattern"] (ReqArg (\x o -> o { freeIconPattern = Just $ parseIconPattern x}) "") "" , Option "" ["used-icon-pattern"] (ReqArg (\x o -> o { usedIconPattern = Just $ parseIconPattern x}) "") "" , Option "c" ["contiguous"] (NoArg (\o -> o {contiguousU = True})) "" ] diskUConfig :: IO MConfig diskUConfig = mkMConfig "" [ "size", "free", "used", "freep", "usedp" , "freebar", "freevbar", "freeipat" , "usedbar", "usedvbar", "usedipat" ] speedToStr :: Float -> String speedToStr = showWithUnits 2 1 . (/ 1024) sizeToStr :: Integer -> String sizeToStr = showWithUnits 3 0 . fromIntegral runDiskIO' :: DiskIOOpts -> (String, [Float]) -> Monitor String runDiskIO' opts (tmp, xs) = do s <- mapM (showWithColors speedToStr) xs b <- mapM (showLogBar 0.8) xs vb <- mapM (showLogVBar 0.8) xs ipat <- mapM (\(f,v) -> showLogIconPattern (f opts) 0.8 v) $ zip [totalIconPattern, readIconPattern, writeIconPattern , totalIconPattern, readIconPattern, writeIconPattern] xs setConfigValue tmp template parseTemplate $ s ++ b ++ vb ++ ipat runDiskIO :: MD.DevDataRef -> [(String, String)] -> [String] -> Monitor String runDiskIO dref disks argv = do opts <- io $ parseOptsWith dioOptions dioDefaultOpts argv stats <- io $ MD.fetchDataIO dref disks mounted <- io $ MD.fetchDataUsage disks strs <- mapM (runDiskIO' opts) $ devTemplates disks (map fst mounted) stats return $ (if contiguous opts then concat else unwords) strs startDiskIO :: [(String, String)] -> [String] -> Int -> (String -> IO ()) -> IO () startDiskIO disks args rate cb = do dref <- MD.initializeDevDataRef disks runM args diskIOConfig (runDiskIO dref disks) rate cb runDiskU' :: DiskUOpts -> String -> [Integer] -> Monitor String runDiskU' opts tmp stat = do setConfigValue tmp template let [total, free, diff] = stat strs = map sizeToStr [free, diff] freep = if total > 0 then free * 100 `div` total else 0 fr = fromIntegral freep / 100 s <- zipWithM showWithColors' strs [freep, 100 - freep] sp <- showPercentsWithColors [fr, 1 - fr] fb <- showPercentBar (fromIntegral freep) fr fvb <- showVerticalBar (fromIntegral freep) fr fipat <- showIconPattern (freeIconPattern opts) fr ub <- showPercentBar (fromIntegral $ 100 - freep) (1 - fr) uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr) uipat <- showIconPattern (usedIconPattern opts) (1 - fr) parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat] runDiskU :: [(String, String)] -> [String] -> Monitor String runDiskU disks argv = do opts <- io $ parseOptsWith duOptions duDefaultOpts argv stats <- io $ MD.fetchDataUsage disks strs <- mapM (\((d, p), stat) -> runDiskU' opts (findTempl d p disks) stat) stats return $ (if contiguousU opts then concat else unwords) strs findTempl :: DevName -> Path -> [(String, String)] -> String findTempl dev path disks = case find devOrPath disks of Just (_, t) -> t Nothing -> "" where devOrPath (d, _) = d == dev || d == path devTemplates :: [(String, String)] -> [(DevName, Path)] -> [(DevName, [Float])] -> [(String, [Float])] devTemplates disks mounted dat = map (\(d, p) -> (findTempl d p disks, findData d)) mounted where findData dev = case find ((==dev) . fst) dat of Nothing -> [0, 0, 0] Just (_, xs) -> xs �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Disk/�������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017270� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Disk/Common.hs����������������������������������������������0000644�0000000�0000000�00000001141�07346545000�021051� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk.Common -- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Disk usage and throughput monitors for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Disk.Common ( DevName , Path ) where type DevName = String type Path = String �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc��������������������������������������������0000644�0000000�0000000�00000033163�07346545000�021207� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CApiFFI #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NumDecimals #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk.Freebsd -- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Disk usage and throughput monitors for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Disk.FreeBSD ( fetchDataIO , fetchDataUsage , initializeDevDataRef , DevDataRef ) where import Data.IORef ( IORef , newIORef , readIORef , writeIORef ) import Xmobar.Plugins.Monitors.Disk.Common ( DevName , Path ) import qualified Control.Exception.Extensible as E import qualified Data.List as DL import qualified Data.Map as DM import qualified Data.Set as DS import Data.Time.Clock.POSIX import Foreign import Foreign.C.Error (throwErrnoIfMinus1_) import Foreign.C.String import Foreign.C.Types import System.BSD.Sysctl #include <sys/sysctl.h> #include <sys/mount.h> #include <devstat.h> #include <libgeom.h> foreign import ccall unsafe "sys/mount.h getfsstat" c_getfsstat :: Ptr STATFS -> CInt -> CInt -> IO CInt foreign import ccall unsafe "geom_stats_open" c_geom_stats_open :: IO CInt foreign import ccall unsafe "geom_stats_snapshot_get" c_geom_stats_snapshot_get :: IO (Ptr GSNAP) foreign import ccall unsafe "&geom_stats_snapshot_free" c_geom_stats_snapshot_free :: FinalizerPtr GSNAP foreign import ccall unsafe "geom_stats_snapshot_next" c_geom_stats_snapshot_next :: Ptr GSNAP -> IO (Ptr DEVSTAT) foreign import ccall unsafe "geom_gettree" c_geom_gettree :: Ptr GMESH -> IO CInt foreign import ccall unsafe "geom_lookupid" c_geom_lookupid :: Ptr GMESH -> Ptr VOIDPTR -> IO (Ptr GIDENT) foreign import ccall unsafe "&geom_deletetree" c_geom_deletetree :: FinalizerPtr GMESH foreign import ccall unsafe "geom_stats_snapshot_timestamp" c_geom_stats_snapshot_timestamp :: Ptr GSNAP -> Ptr Timespec -> IO CInt type DevDataRef = IORef (DM.Map String DevStatData) data STATFS data StatFs = StatFs !(ForeignPtr STATFS) deriving (Eq, Show) data DEVSTAT data DevStat = DevStat !(ForeignPtr DEVSTAT) deriving (Eq, Show) data GMESH data GMesh = GMesh !(ForeignPtr GMESH) data GSNAP data GSnap = GSnap !(ForeignPtr GSNAP) data GIDENT data VOIDPTR data Timespec data DevStatData = DevStatData { devname :: String , readDevStat :: Int64 , writeDevStat :: Int64 , devstatId :: Ptr VOIDPTR , devStatTime :: Rational } deriving (Show, Eq) data StatFsData = StatFsData { fsMntFromName :: String , fsMntOnName :: String , fsStatBlockSize :: Integer -- ^ Optimal transfer block size. , fsStatBlockCount :: Integer -- ^ Total data blocks in file system. , fsStatByteCount :: Integer -- ^ Total bytes in file system. , fsStatBytesFree :: Integer -- ^ Free bytes in file system. , fsStatBytesAvailable :: Integer -- ^ Free bytes available to non-superusers. , fsStatBytesUsed :: Integer -- ^ Bytes used. } deriving (Show, Read, Eq) data GIdentData = GIdentData { lgPtr :: Ptr VOIDPTR , lgWhat :: CInt } deriving (Show, Eq) instance Storable GIdentData where alignment _ = #{alignment struct gident} sizeOf _ = #{size struct gident} peek ptr = do gIdentLgPtr <- #{peek struct gident, lg_ptr} ptr :: IO (Ptr VOIDPTR) gIdentLgWhat <- #{peek struct gident, lg_what} ptr :: IO CInt return GIdentData { lgPtr=gIdentLgPtr , lgWhat=gIdentLgWhat } poke _ _ = pure () instance Storable DevStatData where alignment _ = #{alignment struct devstat} sizeOf _ = #{size struct devstat} peek ptr = do device_id <- #{peek struct devstat, id} ptr :: IO (Ptr VOIDPTR) device_name <- peekCString $ #{ptr struct devstat, device_name} ptr unit_number <- #{peek struct devstat, unit_number} ptr :: IO Int bytes_values <- peekArray 4 $ #{ptr struct devstat, bytes} ptr :: IO [CUIntMax] let read_value = bytes_values !! #{const DEVSTAT_READ} write_value = bytes_values !! #{const DEVSTAT_WRITE} return DevStatData { devname=concat [device_name, show unit_number] , readDevStat=fromInteger . toInteger $ read_value , writeDevStat=fromInteger . toInteger $ write_value , devstatId=device_id , devStatTime=0 } poke _ _ = pure () instance Storable StatFsData where alignment _ = #{alignment struct statfs} sizeOf _ = #{size struct statfs} peek ptr = do fmntfromname <- peekCString $ #{ptr struct statfs, f_mntfromname} ptr fmntonname <- peekCString $ #{ptr struct statfs, f_mntonname} ptr bsize <- #{peek struct statfs, f_bsize} ptr bcount <- #{peek struct statfs, f_blocks} ptr bfree <- #{peek struct statfs, f_bfree} ptr bavail <- #{peek struct statfs, f_bavail} ptr let bpb = toI bsize return $ StatFsData { fsMntFromName = fmntfromname , fsMntOnName = fmntonname , fsStatBlockSize = bpb , fsStatBlockCount = toI bcount , fsStatByteCount = toI bcount * bpb , fsStatBytesFree = toI bfree * bpb , fsStatBytesAvailable = toI bavail * bpb , fsStatBytesUsed = toI (bcount - bfree) * bpb } poke _ _ = pure () toI :: CULong -> Integer toI = toInteger mountCount :: IO CInt mountCount = c_getfsstat nullPtr 0 #{const MNT_NOWAIT} getMountInfo :: IO [StatFsData] getMountInfo = do cmountcount <- mountCount let cbytes = cmountcount * #{size struct statfs} bytes = fromInteger . toInteger $ cbytes mountcount = fromInteger . toInteger $ cmountcount allocaBytes bytes $ \vfs -> do c_getfsstat vfs cbytes #{const MNT_NOWAIT} peekArray mountcount $ castPtr vfs :: IO [StatFsData] cTimeToInteger :: CTime -> Integer cTimeToInteger (CTime n) = fromIntegral n getSnapshotTime :: GSnap -> IO Integer getSnapshotTime (GSnap snap_fp) = do allocaBytes #{const sizeof(struct timespec)} $ \p_ts -> do withForeignPtr snap_fp $ \snap_ptr -> do throwErrnoIfMinus1_ "geom_stats_snapshot_timestamp" $ c_geom_stats_snapshot_timestamp snap_ptr p_ts u_sec <- #{peek struct timespec,tv_sec} p_ts :: IO CTime u_nsec <- #{peek struct timespec,tv_nsec} p_ts :: IO CLong return (cTimeToInteger u_sec * 1e12 + fromIntegral u_nsec * 1e3) checkGeomStat' :: GIdentData -> GSnap -> DevStatData -> [DevStatData] -> IO [DevStatData] checkGeomStat' gident_data gsnap stat acc | (lgWhat gident_data) /= #{const ISPROVIDER} = return acc | otherwise = do lgNamePtr <- #{peek struct gprovider, lg_name} $ lgPtr gident_data lgName <- peekCString $ castPtr lgNamePtr lgTime <- toRational <$> getSnapshotTime gsnap return $ stat { devname=concat ["/dev/", lgName] , devStatTime= lgTime / 1e12 } : acc checkGeomStat :: Ptr GIDENT -> GSnap -> DevStatData -> [DevStatData] -> IO [DevStatData] checkGeomStat gident_ptr gsnap stat acc | gident_ptr == nullPtr = return acc | otherwise = do gIdent <- peek $ castPtr gident_ptr :: IO GIdentData checkGeomStat' gIdent gsnap stat acc getGeomStats' :: GMesh -> GSnap -> Ptr DEVSTAT -> [DevStatData] -> IO [DevStatData] getGeomStats' gmeshD@(GMesh gmesh_fp) gsnapD@(GSnap snap_fp) ptr acc | ptr == nullPtr = return acc | otherwise = do withForeignPtr snap_fp $ \snap_ptr -> do acc' <- withForeignPtr gmesh_fp $ \gmesh_ptr -> do stat <- (peek $ castPtr ptr) :: IO DevStatData gIdentPtr <- c_geom_lookupid gmesh_ptr (devstatId stat) checkGeomStat gIdentPtr gsnapD stat acc nextStatPtr <- c_geom_stats_snapshot_next snap_ptr getGeomStats' gmeshD gsnapD nextStatPtr acc' getGeomStats :: IO [DevStatData] getGeomStats = do gmesh_fp <- mallocForeignPtrBytes bytesmesh addForeignPtrFinalizer c_geom_deletetree gmesh_fp c_geom_stats_open withForeignPtr gmesh_fp $ \gmesh_ptr -> do c_geom_gettree gmesh_ptr snap_ptr <- c_geom_stats_snapshot_get snap_fp <- newForeignPtr c_geom_stats_snapshot_free snap_ptr withForeignPtr snap_fp $ \snap_ptr' -> do nextStatPtr <- c_geom_stats_snapshot_next snap_ptr' getGeomStats' (GMesh gmesh_fp) (GSnap snap_fp) nextStatPtr [] where bytesmesh = #{size struct gmesh} readGeomStats :: DM.Map String DevStatData -> IO (DM.Map String DevStatData) readGeomStats acc = do (Prelude.foldr (\x-> DM.insert (devname x) x) acc) <$> getGeomStats defaultDevStatData :: DevStatData defaultDevStatData = DevStatData { devname = "" , readDevStat = 0 , writeDevStat = 0 , devstatId = nullPtr , devStatTime = 0 } sysctlNextOid :: [Int32] -> IO [Int32] sysctlNextOid oid = do let query_oid = #{const CTL_SYSCTL} : #{const CTL_SYSCTL_NEXT} : oid E.catch (sysctlPeekArray query_oid :: IO [Int32]) (\(E.SomeException _) -> return []) sysctlOidToName :: [Int32] -> IO String sysctlOidToName oid = do let query_oid = #{const CTL_SYSCTL} : #{const CTL_SYSCTL_NAME} : oid nameO <- sysctlReadString query_oid return nameO fetchZfsStat :: [Int32] -> DM.Map (String, String) DevStatData -> [String] -> IO (DM.Map (String, String) DevStatData) fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "nread" : []) = do readsB <- sysctlReadLong oid let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc val' = val { readDevStat = readsB } return $ DM.insert (poolName, refName) val' acc fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "nwritten" : []) = do writesB <- sysctlReadLong oid let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc val' = val { writeDevStat = writesB } return $ DM.insert (poolName, refName) val' acc fetchZfsStat oid acc (_ : _ : poolName : "dataset" : refName : "dataset_name" : []) = do datasetName <- sysctlReadString oid datasetTime <- toRational <$> getPOSIXTime let val = DM.findWithDefault defaultDevStatData (poolName, refName) acc val' = val { devname = datasetName , devStatTime = datasetTime } return $ DM.insert (poolName, refName) val' acc fetchZfsStat _ acc _ = return acc readZfsStat' :: [Int32] -> [Int32] -> DM.Map (String, String) DevStatData -> IO (DM.Map (String, String) DevStatData) readZfsStat' mainOid actOid acc | mainOid `DL.isPrefixOf` actOid = do nameDS <- sysctlOidToName actOid let nameArr = splitOnDot nameDS acc' <- fetchZfsStat actOid acc nameArr nextOid <- sysctlNextOid actOid readZfsStat' mainOid nextOid acc' | otherwise = return acc splitOnDot :: String -> [String] splitOnDot [] = [[]] splitOnDot ('.':xs) = [] : splitOnDot xs splitOnDot (x:xs) = let rest = splitOnDot xs in (x : head rest) : tail rest readZfsStats :: DM.Map DevName DevStatData -> IO (DM.Map DevName DevStatData) readZfsStats acc = do mainO <- sysctlNameToOid "kstat.zfs" mainOid <- sysctlExtractOid mainO (DM.foldr (\x-> DM.insert (devname x) x) acc) <$> (readZfsStat' mainOid mainOid $ DM.empty) readDevsStats :: IO (DM.Map DevName DevStatData) readDevsStats = do geomStats <- readGeomStats DM.empty readZfsStats geomStats extractDataIO :: DM.Map String DevStatData -> DM.Map String DevStatData -> String -> (DevName, [Float]) extractDataIO currs prevs disk = (disk, diffStat) where diffStat = [sp, rSp, wSp, fromInteger t, fromInteger r, fromInteger w] r = toInteger $ (readDevStat curr) - (readDevStat prev) w = toInteger $ (writeDevStat curr) - (writeDevStat prev) t = r + w rSp = speed r diffTime wSp = speed w diffTime sp = speed t diffTime curr = DM.findWithDefault defaultDevStatData disk currs prev = DM.findWithDefault defaultDevStatData disk prevs diffTime = (devStatTime curr) - (devStatTime prev) speed :: Integer -> Rational -> Float speed _ 0 = 0 speed x d = (fromInteger x) / (realToFrac d) fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(DevName, [Float])] fetchDataIO dref disks = do currStats <- readDevsStats prevStats <- readIORef dref writeIORef dref currStats return $ map (extractDataIO currStats prevStats) $ mountedOrDiskDevices disks currStats fetchDataUsage :: [(String, String)] -> IO [((DevName, Path), [Integer])] fetchDataUsage disks = Prelude.map extractStat <$> Prelude.filter isReq <$> getMountInfo where req = Prelude.map fst disks isReq :: StatFsData -> Bool isReq stat = (fsMntOnName stat) `elem` req || Prelude.drop 5 (fsMntFromName stat) `elem` req || (fsMntFromName stat) `elem` req extractStat :: StatFsData -> ((String, String), [Integer]) extractStat stat = ((fsMntFromName stat, fsMntOnName stat) , [ fsStatByteCount stat , fsStatBytesFree stat , fsStatBytesUsed stat ] ) initializeDevDataRef :: [(String, String)] -> IO DevDataRef initializeDevDataRef _ = do stats <- readDevsStats newIORef stats mountedOrDiskDevices :: [(DevName, Path)] -> DM.Map String DevStatData -> [DevName] mountedOrDiskDevices mounted devs = DS.elems $ mountedOrDiskDevices' mountedAcc (DM.keys devs) where mountedAcc = mountedOrDiskDevices' DS.empty (map fst mounted) mountedOrDiskDevices' :: DS.Set DevName -> [DevName] -> DS.Set DevName mountedOrDiskDevices' acc [] = acc mountedOrDiskDevices' acc (x:xs) = mountedOrDiskDevices' (DS.insert x acc) xs �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Disk/Linux.hs�����������������������������������������������0000644�0000000�0000000�00000011040�07346545000�020717� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk.Linux -- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Disk usage and throughput monitors for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Disk.Linux ( fetchDataIO , fetchDataUsage , initializeDevDataRef , DevDataRef ) where import Data.IORef ( IORef , newIORef , readIORef , writeIORef ) import Xmobar.System.StatFS ( getFileSystemStats , fsStatByteCount , fsStatBytesAvailable , fsStatBytesUsed ) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, find) import Data.Maybe (catMaybes) import System.Directory (canonicalizePath, doesFileExist) import Control.Exception (SomeException, handle) import Xmobar.Plugins.Monitors.Disk.Common ( DevName , Path ) type DevDataRef = IORef [(DevName, [Float])] 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] mountedDevices :: [String] -> IO [(DevName, Path)] mountedDevices req = do s <- B.readFile "/etc/mtab" parse `fmap` mapM mbcanon (devs s) where mbcanon (d, p) = doesFileExist d >>= \e -> if e then Just `fmap` canon (d,p) else return Nothing canon (d, p) = do {d' <- canonicalizePath d; return (d', p)} devs = filter isDev . map (firstTwo . B.words) . B.lines parse = map undev . filter isReq . catMaybes firstTwo (a:b:_) = (B.unpack a, B.unpack b) firstTwo _ = ("", "") isDev (d, _) = "/dev/" `isPrefixOf` d 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" let extract ws = (head ws, map read (tail ws)) return $ map (extract . map B.unpack . drop 2 . B.words) (B.lines s) mountedData :: DevDataRef -> [DevName] -> IO [(DevName, [Float])] mountedData dref devs = do dt <- readIORef dref dt' <- diskData writeIORef dref dt' return $ map (parseDev (zipWith diff dt' dt)) devs where diff (dev, xs) (_, ys) = (dev, zipWith (-) xs ys) parseDev :: [(DevName, [Float])] -> DevName -> (DevName, [Float]) parseDev dat dev = case find ((==dev) . fst) dat of Nothing -> (dev, [0, 0, 0]) Just (_, xs) -> let r = 4096 * xs !! 2 w = 4096 * xs !! 6 t = r + w rSp = speed r (xs !! 3) wSp = speed w (xs !! 7) sp = speed t (xs !! 3 + xs !! 7) speed x d = if d == 0 then 0 else x / d dat' = if length xs > 6 then [sp, rSp, wSp, t, r, w] else [0, 0, 0, 0, 0, 0] in (dev, dat') fetchDataIO :: DevDataRef -> [(String, String)] -> IO [(String, [Float])] fetchDataIO dref disks = do dev <- mountedOrDiskDevices (map fst disks) mountedData dref (map fst dev) fetchDataUsage :: [(String, String)] -> IO [((String, String), [Integer])] fetchDataUsage disks = do devs <- mountedDevices (map fst disks) mapM fetchStats devs where fetchStats :: (String, String) -> IO ((String, String), [Integer]) fetchStats (dev, path) = do stats <- handle ign $ fsStats path return ((dev, path), stats) ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer] initializeDevDataRef :: [(String, String)] -> IO DevDataRef initializeDevDataRef disks = do dev <- mountedOrDiskDevices (map fst disks) newIORef (map (\d -> (fst d, repeat 0)) dev) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/K10Temp.hs��������������������������������������������������0000644�0000000�0000000�00000002773�07346545000�020124� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.CoreTemp -- Copyright : (c) Juraj Hercek -- License : BSD-style (see LICENSE) -- -- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> -- Stability : unstable -- Portability : unportable -- -- A temperature monitor that works with AMD CPUs for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.K10Temp where import Xmobar.Plugins.Monitors.Common -- | -- K10 temperature default configuration. Default template contains only the -- die temperature, user should specify custom template in order to get more -- ccd or IO die temperatures. k10TempConfig :: IO MConfig k10TempConfig = mkMConfig "Temp: <Tdie>C" -- template ["Tctl", "Tdie", "Tccd1", "Tccd2", "Tccd3" ,"Tccd4", "Tccd5", "Tccd6", "Tccd7", "Tccd8" ] -- available replacements -- | -- Base directory for k10temp system bus -- k10Dir :: String k10Dir = "/sys/bus/pci/drivers/k10temp/" -- | -- Function retrieves monitor string holding the temperature -- (or temperatures) runK10Temp :: [String] -> Monitor String runK10Temp args = do dn <- getConfigValue decDigits failureMessage <- getConfigValue naString let slot = head args path = [k10Dir ++ slot ++ "/hwmon/hwmon", "/temp", "_input"] divisor = 1e3 :: Double show' = showDigits (max 0 dn) checkedDataRetrieval failureMessage [path] Nothing (/divisor) show' �����xmobar-0.46/src/Xmobar/Plugins/Monitors/Load.hs�����������������������������������������������������0000644�0000000�0000000�00000002562�07346545000�017616� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Load -- Copyright : Finn Lawler -- License : BSD-style (see LICENSE) -- -- Author : Finn Lawler <flawler@cs.tcd.ie> -- Maintainer : jao <mail@jao.io> -- Stability : unstable -- Portability : unportable -- -- A load average monitor for Xmobar. Adapted from -- Xmobar.Plugins.Monitors.Thermal by Juraj Hercek. -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Load (loadConfig, runLoad) where import Xmobar.Plugins.Monitors.Common import Xmobar.Plugins.Monitors.Load.Common (Result(..)) #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Load.FreeBSD as ML #else import qualified Xmobar.Plugins.Monitors.Load.Linux as ML #endif -- | Default configuration. loadConfig :: IO MConfig loadConfig = mkMConfig "Load: <load1>" ["load1", "load5", "load15"] -- | Retrieves load information. Returns the monitor string parsed -- according to template (either default or user specified). runLoad :: [String] -> Monitor String runLoad _ = do result <- io ML.fetchLoads case result of Result loads -> do d <- getConfigValue decDigits parseTemplate =<< mapM (showWithColors (showDigits d)) loads NA -> getConfigValue naString ����������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Load/�������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017255� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Load/Common.hs����������������������������������������������0000644�0000000�0000000�00000001177�07346545000�021047� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Load.Common -- Copyright : Finn Lawler -- License : BSD-style (see LICENSE) -- -- Author : Finn Lawler <flawler@cs.tcd.ie> -- Maintainer : jao <mail@jao.io> -- Stability : unstable -- Portability : unportable -- -- A load average monitor for Xmobar. Adapted from -- Xmobar.Plugins.Monitors.Thermal by Juraj Hercek. -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Load.Common ( Result(..) ) where data Result = Result [Float] | NA �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc��������������������������������������������0000644�0000000�0000000�00000003361�07346545000�021171� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} {-# LANGUAGE CApiFFI #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Load.FreeBSD -- Copyright : Finn Lawler -- License : BSD-style (see LICENSE) -- -- Author : Finn Lawler <flawler@cs.tcd.ie> -- Maintainer : jao <mail@jao.io> -- Stability : unstable -- Portability : unportable -- -- A load average monitor for Xmobar. Adapted from -- Xmobar.Plugins.Monitors.Thermal by Juraj Hercek. -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Load.FreeBSD (fetchLoads) where import Xmobar.Plugins.Monitors.Load.Common (Result(..)) import Foreign.C.Types (CUInt, CUIntMax) import Foreign.Marshal.Array (peekArray) import Foreign.Ptr (plusPtr) import Foreign.Storable (Storable, alignment, peek, peekByteOff, poke, sizeOf) import System.BSD.Sysctl (sysctlPeek) #include <sys/resource.h> data LoadAvg = LoadAvg {loads :: [Float]} calcLoad :: CUInt -> CUIntMax -> Float calcLoad l s = ((fromIntegral . toInteger) l) / ((fromIntegral . toInteger) s) instance Storable LoadAvg where alignment _ = #{alignment struct loadavg} sizeOf _ = #{size struct loadavg} peek ptr = do load_values <- peekArray 3 $ #{ptr struct loadavg, ldavg} ptr :: IO [CUInt] scale <- #{peek struct loadavg, fscale} ptr :: IO CUIntMax let l1 = calcLoad (load_values !! 0) scale l5 = calcLoad (load_values !! 1) scale l15 = calcLoad (load_values !! 2) scale return $ LoadAvg{loads = [l1, l5, l15]} poke _ _ = pure () fetchLoads :: IO Result fetchLoads = do res <- sysctlPeek "vm.loadavg" :: IO LoadAvg return $ Result (loads res) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Load/Linux.hs�����������������������������������������������0000644�0000000�0000000�00000002152�07346545000�020710� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Load.Linux -- Copyright : Finn Lawler -- License : BSD-style (see LICENSE) -- -- Author : Finn Lawler <flawler@cs.tcd.ie> -- Maintainer : jao <mail@jao.io> -- Stability : unstable -- Portability : unportable -- -- A load average monitor for Xmobar. Adapted from -- Xmobar.Plugins.Monitors.Thermal by Juraj Hercek. -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Load.Linux (fetchLoads) where import Xmobar.Plugins.Monitors.Load.Common (Result(..)) import qualified Data.ByteString.Lazy.Char8 as B import System.Posix.Files (fileExist) -- | Parses the contents of a loadavg proc file, returning -- the list of load averages parseLoadAvgs :: B.ByteString -> Result parseLoadAvgs = Result . map (read . B.unpack) . take 3 . B.words . head . B.lines fetchLoads :: IO Result fetchLoads = do let file = "/proc/loadavg" exists <- fileExist file if exists then parseLoadAvgs <$> B.readFile file else return NA ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/MPD.hs������������������������������������������������������0000644�0000000�0000000�00000011752�07346545000�017360� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.MPD -- Copyright : (c) Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- MPD status and song -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.MPD ( mpdConfig, runMPD, mpdWait, mpdReady ) where import Data.List import Data.Maybe (fromMaybe) import Xmobar.Plugins.Monitors.Common import System.Console.GetOpt import qualified Network.MPD as M import Control.Concurrent (threadDelay) import Control.Monad.Except (catchError) templateVars :: [String] templateVars = [ "bar", "vbar", "ipat", "state", "statei", "volume", "length" , "lapsed", "remaining", "plength", "ppos", "flags", "file" , "name", "artist", "composer", "performer" , "album", "title", "track", "genre", "date" ] mpdConfig :: IO MConfig mpdConfig = mkMConfig "MPD: <state>" templateVars data MOpts = MOpts { mPlaying :: String , mStopped :: String , mPaused :: String , mLapsedIconPattern :: Maybe IconPattern , mPort :: Maybe String , mHost :: Maybe String } defaultOpts :: MOpts defaultOpts = MOpts { mPlaying = ">>" , mStopped = "><" , mPaused = "||" , mLapsedIconPattern = Nothing , mPort = Nothing , mHost = Nothing } options :: [OptDescr (MOpts -> MOpts)] options = [ Option "P" ["playing"] (ReqArg (\x o -> o { mPlaying = x }) "") "" , Option "S" ["stopped"] (ReqArg (\x o -> o { mStopped = x }) "") "" , Option "Z" ["paused"] (ReqArg (\x o -> o { mPaused = x }) "") "" , Option "p" ["port"] (ReqArg (\x o -> o { mPort = Just x }) "") "" , Option "h" ["host"] (ReqArg (\x o -> o { mHost = Just x }) "") "" , Option "" ["lapsed-icon-pattern"] (ReqArg (\x o -> o { mLapsedIconPattern = Just $ parseIconPattern x }) "") "" ] withMPD :: MOpts -> M.MPD a -> IO (M.Response a) withMPD opts a = M.withMPD_ (mHost opts) (mPort opts) a `catchError` (\_ -> return (Left M.NoMPD)) runMPD :: [String] -> Monitor String runMPD args = do opts <- io $ parseOptsWith options defaultOpts args status <- io $ withMPD opts M.status song <- io $ withMPD opts M.currentSong s <- parseMPD status song opts parseTemplate s mpdWait :: IO () mpdWait = do status <- M.withMPD $ M.idle [M.PlayerS, M.MixerS, M.OptionsS] case status of Left _ -> threadDelay 5000 _ -> return () mpdReady :: [String] -> Monitor Bool mpdReady args = do opts <- io $ parseOptsWith options defaultOpts args response <- io $ withMPD opts M.ping case response of Right _ -> return True -- Only cases where MPD isn't responding is an issue; bogus information at -- least won't hold xmobar up. Left M.NoMPD -> return False Left (M.ConnectionError _) -> return False Left _ -> return True parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts -> Monitor [String] parseMPD (Left _) _ _ = getConfigValue naString >>= \na -> return $ na : repeat "" parseMPD (Right st) song opts = do songData <- parseSong song bar <- showPercentBar (100 * b) b vbar <- showVerticalBar (100 * b) b ipat <- showIconPattern (mLapsedIconPattern opts) b return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos, flags] ++ songData where s = M.stState st ss = show s si = stateGlyph s opts vol = int2str $ fromMaybe 0 (M.stVolume st) (p, t) = fromMaybe (0, 0) (M.stTime st) [lap, len, remain] = map showTime [floor p, floor t, max 0 (floor t - floor p)] b = if t > 0 then realToFrac $ p / t else 0 plen = int2str $ M.stPlaylistLength st ppos = maybe "" (int2str . (+1)) $ M.stSongPos st flags = playbackMode st stateGlyph :: M.PlaybackState -> MOpts -> String stateGlyph s o = case s of M.Playing -> mPlaying o M.Paused -> mPaused o M.Stopped -> mStopped o playbackMode :: M.Status -> String playbackMode s = concat [if p s then f else "-" | (p,f) <- [(M.stRepeat,"r"), (M.stRandom,"z"), (M.stSingle,"s"), (M.stConsume,"c")]] parseSong :: M.Response (Maybe M.Song) -> Monitor [String] parseSong (Left _) = return $ repeat "" parseSong (Right Nothing) = return $ repeat "" parseSong (Right (Just s)) = let str sel = maybe "" (intercalate ", " . map M.toString) (M.sgGetTag sel s) sels = [ M.Name, M.Artist, M.Composer, M.Performer , M.Album, M.Title, M.Track, M.Genre, M.Date ] fields = M.toString (M.sgFilePath s) : map str sels in mapM showWithPadding fields showTime :: Integer -> String showTime t = int2str minutes ++ ":" ++ int2str seconds where minutes = t `div` 60 seconds = t `mod` 60 int2str :: (Show a, Num a, Ord a) => a -> String int2str x = if x < 10 then '0':sx else sx where sx = show x ����������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Mem.hs������������������������������������������������������0000644�0000000�0000000�00000005201�07346545000�017446� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-#LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Mem -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A memory monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Mem (memConfig, runMem) where import Xmobar.Plugins.Monitors.Common import System.Console.GetOpt #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Mem.FreeBSD as MM #else import qualified Xmobar.Plugins.Monitors.Mem.Linux as MM #endif data MemOpts = MemOpts { usedIconPattern :: Maybe IconPattern , freeIconPattern :: Maybe IconPattern , availableIconPattern :: Maybe IconPattern , scale :: Float } defaultOpts :: MemOpts defaultOpts = MemOpts { usedIconPattern = Nothing , freeIconPattern = Nothing , availableIconPattern = Nothing , scale = 1.0 } options :: [OptDescr (MemOpts -> MemOpts)] options = [ Option "" ["used-icon-pattern"] (ReqArg (\x o -> o { usedIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["free-icon-pattern"] (ReqArg (\x o -> o { freeIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["available-icon-pattern"] (ReqArg (\x o -> o { availableIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["scale"] (ReqArg (\x o -> o { scale = read x }) "") "" ] memConfig :: IO MConfig memConfig = mkMConfig "Mem: <usedratio>% (<cache>M)" ["usedbar", "usedvbar", "usedipat", "freebar", "freevbar", "freeipat", "availablebar", "availablevbar", "availableipat", "usedratio", "freeratio", "availableratio", "total", "free", "buffer", "cache", "available", "used"] formatMem :: MemOpts -> [Float] -> Monitor [String] formatMem opts (r:fr:ar:xs) = do d <- getConfigValue decDigits let f = showDigits d mon i x = [ showPercentBar (100 * x) x , showVerticalBar (100 * x) x , showIconPattern i x] sequence $ mon (usedIconPattern opts) r ++ mon (freeIconPattern opts) fr ++ mon (availableIconPattern opts) ar ++ map showPercentWithColors [r, fr, ar] ++ map (showWithColors f . (/ scale opts)) xs formatMem _ _ = replicate 10 `fmap` getConfigValue naString runMem :: [String] -> Monitor String runMem argv = do m <- io MM.parseMEM opts <- io $ parseOptsWith options defaultOpts argv l <- formatMem opts m parseTemplate l �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Mem/��������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017114� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Mem/FreeBSD.hs����������������������������������������������0000644�0000000�0000000�00000003477�07346545000�020675� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Mem.FreeBSD -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A memory monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Mem.FreeBSD (parseMEM) where import System.BSD.Sysctl (sysctlReadUInt) parseMEM :: IO [Float] parseMEM = do stats <- mapM sysctlReadUInt [ "vm.stats.vm.v_page_size" , "vm.stats.vm.v_page_count" , "vm.stats.vm.v_free_count" , "vm.stats.vm.v_active_count" , "vm.stats.vm.v_inactive_count" , "vm.stats.vm.v_wire_count" , "vm.stats.vm.v_cache_count"] let [ pagesize, totalpages, freepages, activepages, inactivepages, wiredpages, cachedpages ] = fmap fromIntegral stats usedpages = activepages + wiredpages + cachedpages availablepages = inactivepages + cachedpages + freepages bufferedpages = activepages + inactivepages + wiredpages available = availablepages * pagesize used = usedpages * pagesize free = freepages * pagesize cache = cachedpages * pagesize buffer = bufferedpages * pagesize total = totalpages * pagesize usedratio = usedpages / totalpages freeratio = freepages / totalpages availableratio = availablepages / totalpages return [usedratio, freeratio, availableratio, total, free, buffer, cache, available, used] �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Mem/Linux.hs������������������������������������������������0000644�0000000�0000000�00000002401�07346545000�020544� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Mem.Linux -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A memory monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Mem.Linux (parseMEM) where import qualified Data.Map as M fileMEM :: IO String fileMEM = readFile "/proc/meminfo" parseMEM :: IO [Float] parseMEM = do file <- fileMEM let content = map words $ take 8 $ lines file info = M.fromList $ map ( \line -> (head line, (read $ line !! 1 :: Float) / 1024)) content [total, free, buffer, cache] = map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"] available = M.findWithDefault (free + buffer + cache) "MemAvailable:" info used = total - available usedratio = used / total freeratio = free / total availableratio = available / total return [ usedratio, freeratio, availableratio , total, free, buffer, cache, available, used] ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Mpris.hs����������������������������������������������������0000644�0000000�0000000�00000014042�07346545000�020025� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE OverloadedStrings #-} ---------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Mpris -- Copyright : (c) Artem Tarasov -- License : BSD-style (see LICENSE) -- -- Maintainer : Artem Tarasov <lomereiter@gmail.com> -- Stability : unstable -- Portability : unportable -- -- MPRIS song info -- ---------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Mpris ( mprisConfig, runMPRIS1, runMPRIS2 ) where -- TODO: listen to signals import Xmobar.Plugins.Monitors.Common import Text.Printf (printf) import DBus import qualified DBus.Client as DC import Control.Arrow ((***)) import Data.Maybe ( fromJust ) import Data.Int ( Int32, Int64 ) import Data.Word ( Word32 ) import System.IO.Unsafe ( unsafePerformIO ) import Control.Exception (try) class MprisVersion a where 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 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 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", "xesam:composer", "xesam:genre" ] mprisConfig :: IO MConfig mprisConfig = mkMConfig "<artist> - <title>" [ "album", "artist", "arturl", "length" , "title", "tracknumber" , "composer", "genre" ] {-# NOINLINE dbusClient #-} dbusClient :: DC.Client dbusClient = unsafePerformIO DC.connectSession runMPRIS :: (MprisVersion a) => a -> String -> [String] -> Monitor String runMPRIS version playerName _ = do metadata <- io $ getMetadata version dbusClient playerName if null metadata then getConfigValue naString else mapM showWithPadding (makeList version metadata) >>= parseTemplate runMPRIS1 :: String -> [String] -> Monitor String runMPRIS1 = runMPRIS MprisVersion1 runMPRIS2 :: String -> [String] -> Monitor String runMPRIS2 = runMPRIS MprisVersion2 --------------------------------------------------------------------------- fromVar :: (IsVariant a) => Variant -> a fromVar = fromJust . fromVariant unpackMetadata :: [Variant] -> [(String, Variant)] unpackMetadata [] = [] unpackMetadata xs = (map (fromVar *** fromVar) . unpack . head) xs where unpack v = case variantType v of TypeDictionary _ _ -> dictionaryItems $ fromVar v TypeVariant -> unpack $ fromVar v TypeStructure _ -> let x = structureItems (fromVar v) in if null x then [] else unpack (head x) _ -> [] getMetadata :: (MprisVersion a) => a -> DC.Client -> String -> IO [(String, Variant)] getMetadata version client player = do reply <- try (getMetadataReply version client player) :: IO (Either DC.ClientError [Variant]) return $ case reply of Right metadata -> unpackMetadata metadata; Left _ -> [] makeList :: (MprisVersion a) => a -> [(String, Variant)] -> [String] makeList version md = map getStr (fieldsList version) where formatTime n = (if hh == 0 then printf "%02d:%02d" else printf "%d:%02d:%02d" hh) mm ss where hh = (n `div` 60) `div` 60 mm = (n `div` 60) `mod` 60 ss = n `mod` 60 pInt str v = let num = fromVar v in case str of "mtime" -> formatTime (num `div` 1000) "tracknumber" -> printf "%02d" num "mpris:length" -> formatTime (num `div` 1000000) "xesam:trackNumber" -> printf "%02d" num _ -> (show::Int32 -> String) num pw32 v = printf "%02d" (fromVar v::Word32) plen str v = let num = fromVar v in case str of "mpris:length" -> formatTime (num `div` 1000000) _ -> (show::Int64 -> String) num getStr str = case lookup str md of Nothing -> "" Just v -> case variantType v of TypeString -> fromVar v TypeInt32 -> pInt str v TypeWord32 -> pw32 v TypeInt64 -> plen str v TypeArray TypeString -> let x = arrayItems (fromVar v) in if null x then "" else fromVar (head x) _ -> "" ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs��������������������������������������������0000644�0000000�0000000�00000017706�07346545000�021476� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.MultiCoreTemp -- Copyright : (c) 2019, 2020 Felix Springer -- License : BSD-style (see LICENSE) -- -- Maintainer : Felix Springer <felixspringer149@gmail.com> -- Stability : unstable -- Portability : unportable -- -- A core temperature monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.MultiCoreTemp (startMultiCoreTemp) where import Xmobar.Plugins.Monitors.Common import Control.Monad (filterM) import Data.Char (isDigit) import Data.List (isPrefixOf) import System.Console.GetOpt import System.Directory ( doesDirectoryExist , doesFileExist , listDirectory ) -- | Declare Options. data CTOpts = CTOpts { maxIconPattern :: Maybe IconPattern , avgIconPattern :: Maybe IconPattern , mintemp :: Float , maxtemp :: Float , hwMonitorPath :: Maybe String } -- | Set default Options. defaultOpts :: CTOpts defaultOpts = CTOpts { maxIconPattern = Nothing , avgIconPattern = Nothing , mintemp = 0 , maxtemp = 100 , hwMonitorPath = Nothing } -- | Apply configured Options. options :: [OptDescr (CTOpts -> CTOpts)] options = [ Option [] ["max-icon-pattern"] (ReqArg (\ arg opts -> opts { maxIconPattern = Just $ parseIconPattern arg }) "") "" , Option [] ["avg-icon-pattern"] (ReqArg (\ arg opts -> opts { avgIconPattern = Just $ parseIconPattern arg }) "") "" , Option [] ["mintemp"] (ReqArg (\ arg opts -> opts { mintemp = read arg }) "") "" , Option [] ["maxtemp"] (ReqArg (\ arg opts -> opts { maxtemp = read arg }) "") "" , Option [] ["hwmon-path"] (ReqArg (\ arg opts -> opts { hwMonitorPath = Just arg }) "") "" ] -- | Generate Config with a default template and options. cTConfig :: IO MConfig cTConfig = mkMConfig cTTemplate cTOptions where cTTemplate = "Temp: <max>°C - <maxpc>%" cTOptions = [ "max" , "maxpc" , "maxbar" , "maxvbar" , "maxipat" , "avg" , "avgpc" , "avgbar" , "avgvbar" , "avgipat" ] ++ map (("core" ++) . show) [0 :: Int ..] -- | Returns all paths in dir matching the predicate. getMatchingPathsInDir :: FilePath -> (String -> Bool) -> IO [FilePath] getMatchingPathsInDir dir f = do exists <- doesDirectoryExist dir if exists then do files <- filter f <$> listDirectory dir return $ fmap (\file -> dir ++ "/" ++ file) files else return [] -- | Given a prefix, suffix, and path string, return true if the path string -- format is prefix ++ numeric ++ suffix. numberedPathMatcher :: String -> String -> String -> Bool numberedPathMatcher prefix suffix path = prefix `isPrefixOf` path && not (null digits) && afterDigits == suffix where afterPrefix = drop (length prefix) path digits = takeWhile isDigit afterPrefix afterDigits = dropWhile isDigit afterPrefix -- | Returns the first coretemp.N path found. coretempPath :: IO (Maybe String) coretempPath = do ps <- getMatchingPathsInDir "/sys/bus/platform/devices" coretempMatcher xs <- filterM doesDirectoryExist ps return (if null xs then Nothing else Just $ head xs ++ "/") where coretempMatcher = numberedPathMatcher "coretemp." "" -- | Returns the first hwmonN in coretemp path found or the ones in sys/class. hwmonPaths :: IO [String] hwmonPaths = do p <- coretempPath let (sc, path) = case p of Just s -> (False, s) Nothing -> (True, "/sys/class/") cps <- getMatchingPathsInDir (path ++ "hwmon") hwmonMatcher ecps <- filterM doesDirectoryExist cps return $ if sc || null ecps then ecps else [head ecps] where hwmonMatcher = numberedPathMatcher "hwmon" "" -- | Checks Labels, if they refer to a core and returns Strings of core- -- temperatures. corePaths :: Maybe String -> IO [String] corePaths s = do ps <- case s of Just pth -> return [pth] _ -> hwmonPaths cps <- concat <$> traverse (`getMatchingPathsInDir` corePathMatcher) ps ls <- filterM doesFileExist cps cls <- filterM isLabelFromCore ls return $ map labelToCore cls where corePathMatcher = numberedPathMatcher "temp" "_label" -- | Checks if Label refers to a core. isLabelFromCore :: FilePath -> IO Bool isLabelFromCore p = do a <- readFile p return $ take 4 a `elem` ["Core", "Tdie", "Tctl"] -- | Transform a path to Label to a path to core-temperature. labelToCore :: FilePath -> FilePath labelToCore = (++ "input") . reverse . drop 5 . reverse -- | Reads core-temperatures as data from the system. cTData :: Maybe String -> IO [Float] cTData p = do fps <- corePaths p traverse readSingleFile fps where readSingleFile :: FilePath -> IO Float readSingleFile s = do a <- readFile s return $ parseContent a where parseContent :: String -> Float parseContent = read . head . lines -- | Transforms data of temperatures into temperatures of degree Celsius. parseCT :: CTOpts -> IO [Float] parseCT opts = do rawCTs <- cTData (hwMonitorPath opts) let normalizedCTs = map (/ 1000) rawCTs :: [Float] return normalizedCTs -- | Performs calculation for maximum and average. -- Sets up Bars and Values to be printed. formatCT :: CTOpts -> [Float] -> Monitor [String] formatCT opts cTs = do let CTOpts { mintemp = minT , maxtemp = maxT } = opts domainT = maxT - minT maxCT = maximum cTs avgCT = sum cTs / fromIntegral (length cTs) calcPc t = (t - minT) / domainT maxCTPc = calcPc maxCT avgCTPc = calcPc avgCT cs <- traverse showTempWithColors cTs m <- showTempWithColors maxCT mp <- showWithColors' (show (round (100*maxCTPc) :: Int)) maxCT mb <- showPercentBar maxCT maxCTPc mv <- showVerticalBar maxCT maxCTPc mi <- showIconPattern (maxIconPattern opts) maxCTPc a <- showTempWithColors avgCT ap <- showWithColors' (show (round (100*avgCTPc) :: Int)) avgCT ab <- showPercentBar avgCT avgCTPc av <- showVerticalBar avgCT avgCTPc ai <- showIconPattern (avgIconPattern opts) avgCTPc let ms = [ m , mp , mb , mv , mi ] as = [ a , ap , ab , av , ai ] return (ms ++ as ++ cs) where showTempWithColors :: Float -> Monitor String showTempWithColors = showWithColors (show . (round :: Float -> Int)) runCT :: [String] -> Monitor String runCT argv = do opts <- io $ parseOptsWith options defaultOpts argv cTs <- io $ parseCT opts l <- formatCT opts cTs parseTemplate l startMultiCoreTemp :: [String] -> Int -> (String -> IO ()) -> IO () startMultiCoreTemp a = runM a cTConfig runCT ����������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/MultiCpu.hs�������������������������������������������������0000644�0000000�0000000�00000010420�07346545000�020471� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.MultiCpu -- Copyright : (c) Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A multi-cpu monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.MultiCpu (startMultiCpu) where import Xmobar.Plugins.Monitors.Common import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, transpose, unfoldr) import Data.IORef (IORef, newIORef, readIORef, writeIORef) import System.Console.GetOpt data MultiCpuOpts = MultiCpuOpts { loadIconPatterns :: [IconPattern] , loadIconPattern :: Maybe IconPattern , fallbackIconPattern :: Maybe IconPattern , contiguous :: Bool } defaultOpts :: MultiCpuOpts defaultOpts = MultiCpuOpts { loadIconPatterns = [] , loadIconPattern = Nothing , fallbackIconPattern = Nothing , contiguous = False } options :: [OptDescr (MultiCpuOpts -> MultiCpuOpts)] options = [ Option "" ["load-icon-pattern"] (ReqArg (\x o -> o { loadIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["load-icon-patterns"] (ReqArg (\x o -> o { loadIconPatterns = parseIconPattern x : loadIconPatterns o }) "") "" , Option "" ["fallback-icon-pattern"] (ReqArg (\x o -> o { fallbackIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["contiguous-icons"] (NoArg (\o -> o {contiguous = True})) "" ] variables :: [String] variables = ["bar", "vbar","ipat","total","user","nice","system","idle"] vNum :: Int vNum = length variables multiCpuConfig :: IO MConfig multiCpuConfig = mkMConfig "Cpu: <total>%" $ ["auto" ++ k | k <- variables] ++ [ k ++ n | n <- "" : map show [0 :: Int ..] , k <- variables] type CpuDataRef = IORef [[Int]] cpuData :: IO [[Int]] cpuData = parse `fmap` B.readFile "/proc/stat" where parse = map parseList . cpuLists cpuLists = takeWhile isCpu . map B.words . B.lines isCpu (w:_) = "cpu" `isPrefixOf` B.unpack w isCpu _ = False parseList = map (parseInt . B.unpack) . tail parseCpuData :: CpuDataRef -> IO [[Float]] parseCpuData cref = do as <- readIORef cref bs <- cpuData writeIORef cref bs let p0 = zipWith percent bs as return p0 percent :: [Int] -> [Int] -> [Float] percent b a = if tot > 0 then map (/ tot) $ take 4 dif else [0, 0, 0, 0] where dif = map fromIntegral $ zipWith (-) b a tot = sum dif formatMultiCpus :: MultiCpuOpts -> [[Float]] -> Monitor [String] formatMultiCpus _ [] = return [] formatMultiCpus opts xs = concat <$> mapM (\(i, x) -> formatCpu opts i x) (zip [0..] xs) formatCpu :: MultiCpuOpts -> Int -> [Float] -> Monitor [String] formatCpu opts i xs | length xs < 4 = showPercentsWithColors $ replicate vNum 0.0 | otherwise = let t = sum $ take 3 xs in do b <- showPercentBar (100 * t) t h <- showVerticalBar (100 * t) t d <- showIconPattern tryString t ps <- showPercentsWithColors (t:xs) return (b:h:d:ps) where tryString | i == 0 = loadIconPattern opts | i <= length (loadIconPatterns opts) = Just $ loadIconPatterns opts !! (i - 1) | otherwise = fallbackIconPattern opts splitEvery :: Int -> [a] -> [[a]] splitEvery n = unfoldr (\x -> if null x then Nothing else Just $ splitAt n x) groupData :: [String] -> [[String]] groupData = transpose . tail . splitEvery vNum formatAutoCpus :: MultiCpuOpts -> [String] -> Monitor [String] formatAutoCpus _ [] = return $ replicate vNum "" formatAutoCpus opts xs = return $ map (if contiguous opts then concat else unwords) (groupData xs) runMultiCpu :: CpuDataRef -> [String] -> Monitor String runMultiCpu cref argv = do c <- io $ parseCpuData cref opts <- io $ parseOptsWith options defaultOpts argv l <- formatMultiCpus opts c a <- formatAutoCpus opts l parseTemplate $ a ++ l startMultiCpu :: [String] -> Int -> (String -> IO ()) -> IO () startMultiCpu a r cb = do cref <- newIORef [[]] _ <- parseCpuData cref runM a multiCpuConfig (runMultiCpu cref) r cb ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Net.hs������������������������������������������������������0000644�0000000�0000000�00000012760�07346545000�017466� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Net -- Copyright : (c) 2011, 2012, 2013, 2014, 2017, 2020 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A net device monitor for Xmobar -- ----------------------------------------------------------------------------- {-# LANGUAGE CPP #-} module Xmobar.Plugins.Monitors.Net ( startNet , startDynNet ) where import Xmobar.Plugins.Monitors.Common import Xmobar.Plugins.Monitors.Net.Common (NetDev(..), NetDevInfo(..), NetDevRate, NetDevRef) import Data.IORef (newIORef, readIORef, writeIORef) import Data.Time.Clock (getCurrentTime, diffUTCTime) import System.Console.GetOpt #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Net.FreeBSD as MN #else import qualified Xmobar.Plugins.Monitors.Net.Linux as MN #endif import Control.Monad (forM) type DevList = [String] parseDevList :: String -> DevList parseDevList = splitOnComma where splitOnComma [] = [[]] splitOnComma (',':xs) = [] : splitOnComma xs splitOnComma (x:xs) = let rest = splitOnComma xs in (x : head rest) : tail rest data NetOpts = NetOpts { rxIconPattern :: Maybe IconPattern , txIconPattern :: Maybe IconPattern , onlyDevList :: Maybe DevList , upIndicator :: String } defaultOpts :: NetOpts defaultOpts = NetOpts { rxIconPattern = Nothing , txIconPattern = Nothing , onlyDevList = Nothing , upIndicator = "+" } options :: [OptDescr (NetOpts -> NetOpts)] options = [ Option "" ["rx-icon-pattern"] (ReqArg (\x o -> o { rxIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["tx-icon-pattern"] (ReqArg (\x o -> o { txIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["up"] (ReqArg (\x o -> o { upIndicator = x }) "") "" , Option "" ["devices"] (ReqArg (\x o -> o { onlyDevList = Just $ parseDevList x }) "") "" ] data UnitPerSec = Bs | KBs | MBs | GBs deriving (Eq,Enum,Ord) data NetValue = NetValue Float UnitPerSec deriving (Eq,Show) instance Show UnitPerSec where show Bs = "B/s" show KBs = "KB/s" show MBs = "MB/s" show GBs = "GB/s" netConfig :: IO MConfig netConfig = mkMConfig "<dev>: <rx>KB|<tx>KB" -- template ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat", "up"] -- available replacements formatNet :: Maybe IconPattern -> Float -> Monitor (String, String, String, String) formatNet mipat d = do s <- getConfigValue useSuffix dd <- getConfigValue decDigits let str True v = showDigits dd d' ++ show u where (NetValue d' u) = byteNetVal v str False v = showDigits dd $ v / 1024 b <- showLogBar 0.9 d vb <- showLogVBar 0.9 d ipat <- showLogIconPattern mipat 0.9 d x <- showWithColors (str s) d return (x, b, vb, ipat) printNet :: NetOpts -> NetDevRate -> Monitor String printNet opts nd = case nd of N d (ND r t) -> do (rx, rb, rvb, ripat) <- formatNet (rxIconPattern opts) r (tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat, upIndicator opts] N _ NI -> return "" NA -> getConfigValue naString parseNet :: NetDevRef -> String -> IO NetDevRate parseNet nref nd = do (n0, t0) <- readIORef nref n1 <- MN.findNetDev nd t1 <- getCurrentTime writeIORef nref (n1, t1) let scx = realToFrac (diffUTCTime t1 t0) scx' = if scx > 0 then scx else 1 rate da db = takeDigits 2 $ fromIntegral (db - da) / scx' diffRate (N d (ND ra ta)) (N _ (ND rb tb)) = N d (ND (rate ra rb) (rate ta tb)) diffRate (N d NI) _ = N d NI diffRate _ (N d NI) = N d NI diffRate _ _ = NA return $ diffRate n0 n1 runNet :: NetDevRef -> String -> [String] -> Monitor String runNet nref i argv = do dev <- io $ parseNet nref i opts <- io $ parseOptsWith options defaultOpts argv printNet opts dev parseNets :: [(NetDevRef, String)] -> IO [NetDevRate] parseNets = mapM $ uncurry parseNet runNets :: [(NetDevRef, String)] -> [String] -> Monitor String runNets refs argv = do opts <- io $ parseOptsWith options defaultOpts argv dev <- io $ parseActive $ filterRefs opts refs printNet opts dev where parseActive refs' = fmap selectActive (parseNets refs') refInDevList opts' (_, refname') = case onlyDevList opts' of Just theList -> refname' `elem` theList Nothing -> True filterRefs opts' refs' = case filter (refInDevList opts') refs' of [] -> refs' xs -> xs 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 <- MN.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 byteNetVal :: Float -> NetValue byteNetVal v | v < 1024**1 = NetValue v Bs | v < 1024**2 = NetValue (v/1024**1) KBs | v < 1024**3 = NetValue (v/1024**2) MBs | otherwise = NetValue (v/1024**3) GBs ����������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Net/��������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017124� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Net/Common.hs�����������������������������������������������0000644�0000000�0000000�00000003312�07346545000�020707� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Net.Common -- Copyright : (c) 2011, 2012, 2013, 2014, 2017, 2020 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A net device monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Net.Common ( NetDev(..) , NetDevInfo(..) , NetDevRawTotal , NetDevRate , NetDevRef ) where import Data.IORef (IORef) import Data.Time.Clock (UTCTime) import Data.Word (Word64) data NetDev num = N String (NetDevInfo num) | NA deriving (Eq,Show,Read) data NetDevInfo num = NI | ND num num deriving (Eq,Show,Read) type NetDevRawTotal = NetDev Word64 type NetDevRate = NetDev Float type NetDevRef = IORef (NetDevRawTotal, 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 num => Ord (NetDev num) where compare NA NA = EQ compare NA _ = LT compare _ NA = GT compare (N _ i1) (N _ i2) = i1 `compare` i2 instance Ord num => Ord (NetDevInfo num) where compare NI NI = EQ compare NI ND {} = LT compare ND {} NI = GT compare (ND x1 y1) (ND x2 y2) = x1 `compare` x2 <> y1 `compare` y2 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc���������������������������������������������0000644�0000000�0000000�00000007145�07346545000�021044� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE CPP #-} {-# LANGUAGE CApiFFI #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Net.FreeBSD -- Copyright : (c) 2011, 2012, 2013, 2014, 2017, 2020 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A net device monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Net.FreeBSD ( existingDevs , findNetDev ) where import Xmobar.Plugins.Monitors.Net.Common (NetDevRawTotal, NetDev(..), NetDevInfo(..)) import Control.Exception (catch, SomeException(..)) import Foreign (Int32, plusPtr) import Foreign.C.Types (CUIntMax, CUChar) import Foreign.C.String (peekCString) import Foreign.Storable (Storable, alignment, sizeOf, peek, poke) import System.BSD.Sysctl (OID, sysctlPrepareOid, sysctlReadInt, sysctlPeek) #include <sys/sysctl.h> #include <net/if.h> #include <net/if_mib.h> data IfData = AvailableIfData { name :: String , txBytes :: CUIntMax , rxBytes :: CUIntMax , isUp :: Bool } | NotAvailableIfData deriving (Show, Read, Eq) instance Storable IfData where alignment _ = #{alignment struct ifmibdata} sizeOf _ = #{size struct ifmibdata} peek ptr = do cname <- peekCString (ptr `plusPtr` (#offset struct ifmibdata, ifmd_name)) tx <- peek ((ifmd_data_ptr ptr) `plusPtr` (#offset struct if_data, ifi_obytes)) :: IO CUIntMax rx <- peek ((ifmd_data_ptr ptr) `plusPtr` (#offset struct if_data, ifi_ibytes)) :: IO CUIntMax state <- peek ((ifmd_data_ptr ptr) `plusPtr` (#offset struct if_data, ifi_link_state)) :: IO CUChar return $ AvailableIfData {name = cname, txBytes = tx, rxBytes = rx, isUp = up state} where up state = state == (#const LINK_STATE_UP) ifmd_data_ptr p = p `plusPtr` (#offset struct ifmibdata, ifmd_data) poke _ _ = pure () getNetIfCountOID :: IO OID getNetIfCountOID = sysctlPrepareOid [ #const CTL_NET , #const PF_LINK , #const NETLINK_GENERIC , #const IFMIB_SYSTEM , #const IFMIB_IFCOUNT] getNetIfDataOID :: Int32 -> IO OID getNetIfDataOID i = sysctlPrepareOid [ #const CTL_NET , #const PF_LINK , #const NETLINK_GENERIC , #const IFMIB_IFDATA , i , #const IFDATA_GENERAL] getNetIfCount :: IO Int32 getNetIfCount = do oid <- getNetIfCountOID sysctlReadInt oid getNetIfData :: Int32 -> IO IfData getNetIfData i = do oid <- getNetIfDataOID i res <- catch (sysctlPeek oid) (\(SomeException _) -> return NotAvailableIfData) return res getAllNetworkData :: IO [IfData] getAllNetworkData = do count <- getNetIfCount result <- mapM getNetIfData [1..count] return result existingDevs :: IO [String] existingDevs = getAllNetworkData >>= (\xs -> return $ filter (/= "lo0") $ fmap name xs) convertIfDataToNetDev :: IfData -> IO NetDevRawTotal convertIfDataToNetDev ifData = do let up = isUp ifData rx = fromInteger . toInteger $ rxBytes ifData tx = fromInteger . toInteger $ txBytes ifData d = name ifData return $ N d (if up then ND rx tx else NI) netConvertIfDataToNetDev :: [IfData] -> IO [NetDevRawTotal] netConvertIfDataToNetDev = mapM convertIfDataToNetDev findNetDev :: String -> IO NetDevRawTotal findNetDev dev = do nds <- getAllNetworkData >>= netConvertIfDataToNetDev case filter isDev nds of x:_ -> return x _ -> return NA where isDev (N d _) = d == dev isDev NA = False ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Net/Linux.hs������������������������������������������������0000644�0000000�0000000�00000004354�07346545000�020565� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Net.Linux -- Copyright : (c) 2011, 2012, 2013, 2014, 2017, 2020 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A net device monitor for Xmobar -- ----------------------------------------------------------------------------- {-# LANGUAGE OverloadedStrings #-} module Xmobar.Plugins.Monitors.Net.Linux ( existingDevs , findNetDev ) where import Xmobar.Plugins.Monitors.Net.Common (NetDevRawTotal, NetDev(..), NetDevInfo(..)) import Control.Monad (filterM) import System.Directory (getDirectoryContents, doesFileExist) import System.FilePath ((</>)) import System.IO.Error (catchIOError) import System.IO.Unsafe (unsafeInterleaveIO) import qualified Data.ByteString.Char8 as B 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 = flip catchIOError (const $ return False) $ do operstate <- B.readFile (operstateDir d) return $! (head . B.lines) operstate `elem` ["up", "unknown"] readNetDev :: [String] -> IO NetDevRawTotal readNetDev ~[d, x, y] = do up <- unsafeInterleaveIO $ isUp d return $ N d (if up then ND (r x) (r y) else NI) where r s | s == "" = 0 | otherwise = read s netParser :: B.ByteString -> IO [NetDevRawTotal] netParser = mapM (readNetDev . splitDevLine) . readDevLines where readDevLines = drop 2 . B.lines splitDevLine = map B.unpack . selectCols . filter (not . B.null) . B.splitWith (`elem` [' ',':']) selectCols cols = map (cols!!) [0,1,9] findNetDev :: String -> IO NetDevRawTotal findNetDev dev = do nds <- B.readFile "/proc/net/dev" >>= netParser case filter isDev nds of x:_ -> return x _ -> return NA where isDev (N d _) = d == dev isDev NA = False ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Swap.hs�����������������������������������������������������0000644�0000000�0000000�00000002303�07346545000�017642� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-#LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Swap -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A swap usage monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Swap where import Xmobar.Plugins.Monitors.Common #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Swap.FreeBSD as MS #else import qualified Xmobar.Plugins.Monitors.Swap.Linux as MS #endif swapConfig :: IO MConfig swapConfig = mkMConfig "Swap: <usedratio>%" ["usedratio", "total", "used", "free"] formatSwap :: [Float] -> Monitor [String] formatSwap (r:xs) = do d <- getConfigValue decDigits other <- mapM (showWithColors (showDigits d)) xs ratio <- showPercentWithColors r return $ ratio:other formatSwap _ = replicate 4 `fmap` getConfigValue naString runSwap :: [String] -> Monitor String runSwap _ = do m <- io MS.parseMEM l <- formatSwap m parseTemplate l �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Swap/�������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017310� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc��������������������������������������������0000644�0000000�0000000�00000005450�07346545000�021225� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Swap.FreeBSD -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A swap usage monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Swap.FreeBSD (parseMEM) where import System.BSD.Sysctl (sysctlReadUInt) import Foreign import Foreign.C.Types import Foreign.C.String #include <unistd.h> #include <fcntl.h> #include <kvm.h> #include <limits.h> #include <paths.h> #include <stdlib.h> foreign import ccall unsafe "kvm.h kvm_open" c_kvm_open :: CString -> CString -> CString -> CInt -> CString -> IO (Ptr KVM_T) foreign import ccall "&kvm_close" c_kvm_close :: FinalizerPtr KVM_T foreign import ccall unsafe "kvm.h kvm_getswapinfo" c_kvm_getswapinfo :: Ptr KVM_T -> Ptr KVM_SWAP -> CInt -> CInt -> IO CInt data KVM_T data KvmT = KvmT !(ForeignPtr KVM_T) deriving (Eq, Ord, Show) data KVM_SWAP data KvmSwap = KvmSwap !(ForeignPtr KVM_SWAP) deriving (Eq, Ord, Show) getKvmT:: IO KvmT getKvmT = do withCString "/dev/null" $ \dir -> do kvm_t_ptr <- c_kvm_open nullPtr dir nullPtr #{const O_RDONLY} nullPtr ptr <- newForeignPtr c_kvm_close kvm_t_ptr return $ KvmT ptr getSwapData :: KvmT -> IO SwapData getSwapData (KvmT kvm_t_fp) = do withForeignPtr kvm_t_fp $ \kvm_t_ptr -> do allocaBytes #{size struct kvm_swap} $ \swap_ptr -> do c_kvm_getswapinfo kvm_t_ptr swap_ptr 1 0 peek $ castPtr swap_ptr :: IO SwapData data SwapData = AvailableSwapData { used :: Integer , total :: Integer } | NotAvailableSwapData deriving (Show, Read, Eq) instance Storable SwapData where alignment _ = #{alignment struct kvm_swap} sizeOf _ = #{size struct kvm_swap} peek ptr = do cused <- #{peek struct kvm_swap, ksw_used} ptr :: IO CUInt ctotal <- #{peek struct kvm_swap, ksw_total} ptr :: IO CUInt return $ AvailableSwapData {used = toInteger cused, total = toInteger ctotal} poke _ _ = pure () isEnabled :: IO Bool isEnabled = do enabled <- sysctlReadUInt "vm.swap_enabled" return $ enabled == 1 parseMEM' :: Bool -> IO [Float] parseMEM' False = return [] parseMEM' True = do kvm_t <- getKvmT swap <- getSwapData kvm_t pagesize <- toInteger <$> sysctlReadUInt "vm.stats.vm.v_page_size" let swapTotal = total swap swapUsed = used swap tot = swapTotal * pagesize fr = tot - swapUsed * pagesize return $ res (fromInteger tot) (fromInteger fr) where res :: Float -> Float -> [Float] res _ 0 = [] res t f = [(t-f)/t, t, t - f, f] parseMEM :: IO [Float] parseMEM = do enabled <- isEnabled parseMEM' enabled ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Swap/Linux.hs�����������������������������������������������0000644�0000000�0000000�00000002160�07346545000�020742� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Swap.Linux -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A swap usage monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Swap.Linux (parseMEM) where import qualified Data.ByteString.Lazy.Char8 as B fileMEM :: IO B.ByteString fileMEM = B.readFile "/proc/meminfo" parseMEM :: IO [Float] parseMEM = do file <- fileMEM let li i l | l /= [] = head l !! i | otherwise = B.empty fs s l | null l = False | otherwise = head l == B.pack s get_data s = flip (/) 1024 . read . B.unpack . li 1 . filter (fs s) st = map B.words . B.lines $ file tot = get_data "SwapTotal:" st free = get_data "SwapFree:" st return [(tot - free) / tot, tot, tot - free, free] ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Thermal.hs��������������������������������������������������0000644�0000000�0000000�00000002613�07346545000�020330� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Thermal -- Copyright : (c) Juraj Hercek -- License : BSD-style (see LICENSE) -- -- Maintainer : Juraj Hercek <juhe_haskell@hck.sk> -- Stability : unstable -- Portability : unportable -- -- A thermal monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Thermal where import qualified Data.ByteString.Lazy.Char8 as B import Xmobar.Plugins.Monitors.Common import System.Posix.Files (fileExist) -- | Default thermal configuration. thermalConfig :: IO MConfig thermalConfig = mkMConfig "Thm: <temp>C" -- template ["temp"] -- available replacements -- | Retrieves thermal information. Argument is name of thermal directory in -- \/proc\/acpi\/thermal_zone. Returns the monitor string parsed according to -- template (either default or user specified). runThermal :: [String] -> Monitor String runThermal args = do let zone = head args file = "/proc/acpi/thermal_zone/" ++ zone ++ "/temperature" exists <- io $ fileExist file if exists then do number <- io $ fmap ((read :: String -> Int) . stringParser (1, 0)) (B.readFile file) thermal <- showWithColors show number parseTemplate [ thermal ] else getConfigValue naString ���������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/ThermalZone.hs����������������������������������������������0000644�0000000�0000000�00000003556�07346545000�021173� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module : Plugins.Monitors.ThermalZone -- Copyright : (c) 2011, 2013 Jose Antonio Ortega Ruiz -- License : BSD3-style (see LICENSE) -- -- Maintainer : jao@gnu.org -- Stability : unstable -- Portability : portable -- Created : Fri Feb 25, 2011 03:18 -- -- -- A thermal zone plugin based on the sysfs linux interface. -- See http://kernel.org/doc/Documentation/thermal/sysfs-api.txt -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Monitors.ThermalZone (thermalZoneConfig, runThermalZone) where import Xmobar.Plugins.Monitors.Common import System.Posix.Files (fileExist) import Control.Exception (IOException, catch) import qualified Data.ByteString.Char8 as B -- | Default thermal configuration. thermalZoneConfig :: IO MConfig thermalZoneConfig = mkMConfig "<temp>C" ["temp"] -- | Retrieves thermal information. Argument is name of thermal -- directory in \/sys\/clas\/thermal. Returns the monitor string -- parsed according to template (either default or user specified). runThermalZone :: [String] -> Monitor String runThermalZone args = do let zone = head args file = "/sys/class/thermal/thermal_zone" ++ zone ++ "/temp" handleIOError :: IOException -> IO (Maybe B.ByteString) handleIOError _ = return Nothing parse = return . (read :: String -> Int) . B.unpack exists <- io $ fileExist file if exists then do contents <- io $ catch (fmap Just $ B.readFile file) handleIOError case contents of Just d -> do mdegrees <- parse d temp <- showWithColors show (mdegrees `quot` 1000) parseTemplate [ temp ] Nothing -> getConfigValue naString else getConfigValue naString ��������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Top.hs������������������������������������������������������0000644�0000000�0000000�00000010361�07346545000�017475� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-#LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top -- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018, 2022 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Process activity and memory consumption monitors -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where import Xmobar.Plugins.Monitors.Common import Data.IORef (newIORef, readIORef, writeIORef) import Data.List (sortBy) import Data.Ord (comparing) import Data.Time.Clock (getCurrentTime, diffUTCTime) import Xmobar.Plugins.Monitors.Top.Common ( MemInfo , TimeInfo , Times , TimesRef) #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Top.FreeBSD as MT #else import qualified Xmobar.Plugins.Monitors.Top.Linux as MT #endif maxEntries :: Int maxEntries = 10 intStrs :: [String] intStrs = map show [1..maxEntries] topMemConfig :: IO MConfig topMemConfig = mkMConfig "<both1>" [ k ++ n | n <- intStrs , k <- ["name", "mem", "both"]] topConfig :: IO MConfig topConfig = mkMConfig "<both1>" ("no" : [ k ++ n | n <- intStrs , k <- [ "name", "cpu", "both" , "mname", "mem", "mboth"]]) showInfo :: String -> String -> Float -> Monitor [String] showInfo nm sms mms = do mnw <- getConfigValue maxWidth mxw <- getConfigValue minWidth let lsms = length sms nmw = mnw - lsms - 1 nmx = mxw - lsms - 1 rnm = if nmw > 0 then padString nmw nmx " " True "" nm else nm mstr <- showWithColors' sms mms both <- showWithColors' (rnm ++ " " ++ sms) mms return [nm, mstr, both] sortTop :: [(String, Float)] -> [(String, Float)] sortTop = sortBy (flip (comparing snd)) showMemInfo :: Float -> MemInfo -> Monitor [String] showMemInfo scale (nm, rss) = showInfo nm (showWithUnits 3 1 rss) (100 * rss / sc) where sc = if scale > 0 then scale else 100 showMemInfos :: [MemInfo] -> Monitor [[String]] showMemInfos ms = mapM (showMemInfo tm) ms where tm = sum (map snd ms) timeMemInfos :: IO (Times, [MemInfo], Int) timeMemInfos = fmap res MT.timeMemEntries where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x) combine :: Times -> Times -> Times combine _ [] = [] combine [] ts = ts combine l@((p0, (n0, t0)):ls) r@((p1, (n1, t1)):rs) | p0 == p1 && n0 == n1 = (p0, (n0, t1 - t0)) : combine ls rs | p0 <= p1 = combine ls r | otherwise = (p1, (n1, t1)) : combine l rs take' :: Int -> [a] -> [a] take' m l = let !r = tk m l in length l `seq` r where tk 0 _ = [] tk _ [] = [] tk n (x:xs) = let !r = tk (n - 1) xs in x : r topProcesses :: TimesRef -> Float -> IO (Int, [TimeInfo], [MemInfo]) topProcesses tref scale = do (t0, c0) <- readIORef tref (t1, mis, len) <- timeMemInfos c1 <- getCurrentTime let scx = realToFrac (diffUTCTime c1 c0) * scale !scx' = if scx > 0 then scx else scale nts = map (\(_, (nm, t)) -> (nm, t / scx')) (combine t0 t1) !t1' = take' (length t1) t1 !nts' = take' maxEntries (sortTop nts) !mis' = take' maxEntries (sortTop mis) writeIORef tref (t1', c1) return (len, nts', mis') showTimeInfo :: TimeInfo -> Monitor [String] showTimeInfo (n, t) = getConfigValue decDigits >>= \d -> showInfo n (showDigits d t) t showTimeInfos :: [TimeInfo] -> Monitor [[String]] showTimeInfos = mapM showTimeInfo runTopMem :: [String] -> Monitor String runTopMem _ = do mis <- io MT.meminfos pstr <- showMemInfos (sortTop mis) parseTemplate $ concat pstr runTop :: TimesRef -> Float -> [String] -> Monitor String runTop tref scale _ = do (no, ps, ms) <- io $ topProcesses tref scale pstr <- showTimeInfos ps mstr <- showMemInfos ms na <- getConfigValue naString parseTemplate $ show no : concat (zipWith (++) pstr mstr) ++ repeat na startTop :: [String] -> Int -> (String -> IO ()) -> IO () startTop a r cb = do c <- getCurrentTime tref <- newIORef ([], c) scale <- MT.scale _ <- topProcesses tref scale runM a topConfig (runTop tref scale) r cb �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Top/��������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017140� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Top/Common.hs�����������������������������������������������0000644�0000000�0000000�00000001525�07346545000�020727� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top.Common -- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Process activity and memory consumption monitors -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Top.Common ( MemInfo , Pid , TimeInfo , TimeEntry , Times , TimesRef ) where import Data.IORef (IORef) import Data.Time.Clock (UTCTime) type MemInfo = (String, Float) type Pid = Int type TimeInfo = (String, Float) type TimeEntry = (Pid, TimeInfo) type Times = [TimeEntry] type TimesRef = IORef (Times, UTCTime) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc���������������������������������������������0000644�0000000�0000000�00000010414�07346545000�021051� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} {-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CApiFFI #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top.FreeBSD -- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Process activity and memory consumption monitors -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Top.FreeBSD ( timeMemEntries , meminfos , scale) where import Foreign import Foreign.C.Types import Foreign.C.String import Xmobar.Plugins.Monitors.Top.Common (MemInfo, TimeEntry) #include <unistd.h> #include <sys/sysctl.h> #include <sys/user.h> #include <libprocstat.h> foreign import ccall "unistd.h getpagesize" c_getpagesize :: CInt foreign import ccall unsafe "libprocstat.h procstat_open_sysctl" c_procstat_open_sysctl :: IO (Ptr PROCSTAT) foreign import ccall "&procstat_close" c_procstat_close :: FinalizerPtr PROCSTAT foreign import ccall "&procstat_freeprocs" c_procstat_freeprocs :: FinalizerEnvPtr PROCSTAT KINFO_PROC foreign import ccall unsafe "libprocstat.h procstat_getprocs" c_procstat_getprocs :: Ptr PROCSTAT -> CInt -> CInt -> Ptr CUInt -> IO (Ptr KINFO_PROC) data PROCSTAT data ProcStat = ProcStat !(ForeignPtr PROCSTAT) deriving (Eq, Ord, Show) data KINFO_PROC data KinfoProc = KinfoProc [ProcData] Int deriving (Eq, Show) data ProcData = ProcData { pname :: String , cpu :: Float , tdflags :: CULong , flag :: CULong , stat :: CUChar , rss :: Float , pid :: Int , runtime :: Float } deriving (Show, Read, Eq) instance Storable ProcData where alignment _ = #{alignment struct kinfo_proc} sizeOf _ = #{size struct kinfo_proc} peek ptr = do c <- #{peek struct kinfo_proc, ki_pctcpu} ptr ctdflags <- #{peek struct kinfo_proc, ki_tdflags} ptr cflag <- #{peek struct kinfo_proc, ki_flag} ptr cstat <- #{peek struct kinfo_proc, ki_stat} ptr cruntime <- #{peek struct kinfo_proc, ki_runtime} ptr :: IO CULong crss <- #{peek struct kinfo_proc, ki_rssize} ptr :: IO CULong cname <- peekCString (ptr `plusPtr` (#offset struct kinfo_proc, ki_comm)) cpid <- #{peek struct kinfo_proc, ki_pid} ptr let crssf = (fromIntegral . toInteger) crss let cruntimef = ((fromIntegral . toInteger) cruntime + 500000) / 10000 return $ ProcData { pname = cname , cpu = (pctdouble c) * 100 , tdflags = ctdflags , stat = cstat , flag = cflag , rss = crssf * pageSize , pid = cpid , runtime = cruntimef} poke _ _ = pure () pctdouble :: Int -> Float pctdouble p = (fromIntegral p) / #{const FSCALE} pageSize :: Float pageSize = fromIntegral c_getpagesize / 1024 getProcStat:: IO ProcStat getProcStat = do proc_ptr <- c_procstat_open_sysctl ptr <- newForeignPtr c_procstat_close proc_ptr return $ ProcStat ptr getProcessesInfo :: ProcStat -> IO [ProcData] getProcessesInfo (ProcStat ps_fp) = do withForeignPtr ps_fp $ \ps_ptr -> do alloca $ \n_ptr -> do kinfo_proc_ptr <- c_procstat_getprocs ps_ptr #{const KERN_PROC_PROC} 0 n_ptr newForeignPtrEnv c_procstat_freeprocs ps_ptr kinfo_proc_ptr num <- peek (n_ptr :: Ptr CUInt) pds <- peekArray (fromIntegral num) $ castPtr kinfo_proc_ptr :: IO [ProcData] return $ [p | p <- pds, flag p .&. #{const P_SYSTEM} == 0] processes :: IO [ProcData] processes = do proc_stat <- getProcStat getProcessesInfo proc_stat handleProcesses :: (ProcData -> a) -> IO [a] handleProcesses f = do ps <- processes return $ fmap (\pd -> f pd) ps meminfo :: ProcData -> MemInfo meminfo pd = (pname pd, rss pd) meminfos :: IO [MemInfo] meminfos = handleProcesses meminfo timeMemEntry :: ProcData -> (TimeEntry, MemInfo) timeMemEntry pd = ((p, (n, t)), (n, r)) where p = pid pd n = pname pd t = runtime pd (_, r) = meminfo pd timeMemEntries :: IO [(TimeEntry, MemInfo)] timeMemEntries = handleProcesses timeMemEntry scale :: IO Float scale = return 1 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Top/Linux.hs������������������������������������������������0000644�0000000�0000000�00000005254�07346545000�020601� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top.Linux -- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- Process activity and memory consumption monitors -- ----------------------------------------------------------------------------- {-# LANGUAGE ForeignFunctionInterface #-} module Xmobar.Plugins.Monitors.Top.Linux ( timeMemEntries , meminfos , scale) where import Xmobar.Plugins.Monitors.Common (parseFloat, parseInt) import Xmobar.Plugins.Monitors.Top.Common (MemInfo, TimeEntry) import Control.Exception (SomeException, handle) import Data.List (foldl') import System.Directory (getDirectoryContents) import System.FilePath ((</>)) import System.IO (IOMode(ReadMode), hGetLine, withFile) import System.Posix.Unistd (SysVar(ClockTick), getSysVar) import Foreign.C.Types foreign import ccall "unistd.h getpagesize" c_getpagesize :: CInt pageSize :: Float pageSize = fromIntegral c_getpagesize / 1024 processes :: IO [FilePath] processes = fmap (filter isPid) (getDirectoryContents "/proc") where isPid = (`elem` ['0'..'9']) . head statWords :: [String] -> [String] statWords line@(x:pn:ppn:xs) = if last pn == ')' then line else statWords (x:(pn ++ " " ++ ppn):xs) statWords _ = replicate 52 "0" getProcessData :: FilePath -> IO [String] getProcessData pidf = handle ign $ withFile ("/proc" </> pidf </> "stat") ReadMode readWords where readWords = fmap (statWords . words) . hGetLine ign = const (return []) :: SomeException -> IO [String] memPages :: [String] -> String memPages fs = fs!!23 ppid :: [String] -> String ppid fs = fs!!3 skip :: [String] -> Bool skip fs = length fs < 24 || memPages fs == "0" || ppid fs == "0" handleProcesses :: ([String] -> a) -> IO [a] handleProcesses f = fmap (foldl' (\a p -> if skip p then a else f p : a) []) (processes >>= mapM getProcessData) processName :: [String] -> String processName = drop 1 . init . (!!1) meminfo :: [String] -> MemInfo meminfo fs = (processName fs, pageSize * parseFloat (fs!!23)) meminfos :: IO [MemInfo] meminfos = handleProcesses meminfo timeMemEntry :: [String] -> (TimeEntry, MemInfo) timeMemEntry fs = ((p, (n, t)), (n, r)) where p = parseInt (head fs) n = processName fs t = parseFloat (fs!!13) + parseFloat (fs!!14) (_, r) = meminfo fs timeMemEntries :: IO [(TimeEntry, MemInfo)] timeMemEntries = handleProcesses timeMemEntry scale :: IO Float scale = do cr <- getSysVar ClockTick return $ fromIntegral cr / 100 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/UVMeter.hs��������������������������������������������������0000644�0000000�0000000�00000011533�07346545000�020264� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE OverloadedStrings #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.UVMeter -- Copyright : (c) Róman Joost -- License : BSD-style (see LICENSE) -- -- Maintainer : Róman Joost -- Stability : unstable -- Portability : unportable -- -- An australian uv monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.UVMeter where import Xmobar.Plugins.Monitors.Common import qualified Control.Exception as CE import Network.HTTP.Conduit ( Manager , httpLbs , parseRequest , responseBody ) import Network.HTTP.Client.TLS (getGlobalManager) import Data.ByteString.Lazy.Char8 as B import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option)) import Text.Read (readMaybe) import Text.Parsec import Text.Parsec.String import Control.Monad (void) -- | Options the user may specify. newtype UVMeterOpts = UVMeterOpts { useManager :: Bool } -- | Default values for options. defaultOpts :: UVMeterOpts defaultOpts = UVMeterOpts { useManager = True } -- | Apply options. options :: [OptDescr (UVMeterOpts -> UVMeterOpts)] options = [ Option "m" ["useManager"] (ReqArg (\m o -> o { useManager = read m }) "") "" ] uvConfig :: IO MConfig uvConfig = mkMConfig "<station>" -- template ["station" -- available replacements ] newtype UvInfo = UV { index :: String } deriving (Show) uvURL :: String uvURL = "https://uvdata.arpansa.gov.au/xml/uvvalues.xml" -- | Get the UV data from the given url. getData ::Manager -> IO String getData man = CE.catch (do request <- parseRequest uvURL res <- httpLbs request man return $ B.unpack $ responseBody res) errHandler where errHandler :: CE.SomeException -> IO String errHandler _ = return "<Could not retrieve data>" textToXMLDocument :: String -> Either ParseError [XML] textToXMLDocument = parse document "" formatUVRating :: Maybe Float -> Monitor String formatUVRating Nothing = getConfigValue naString formatUVRating (Just x) = do uv <- showWithColors show x parseTemplate [uv] getUVRating :: String -> [XML] -> Maybe Float getUVRating locID (Element "stations" _ y:_) = getUVRating locID y getUVRating locID (Element "location" [Attribute attr] ys:xs) | locID == snd attr = getUVRating locID ys | otherwise = getUVRating locID xs getUVRating _ (Element "index" [] [Body rate]:_) = readMaybe rate getUVRating locID (_:xs) = getUVRating locID xs getUVRating _ [] = Nothing -- | Start the uvmeter monitor, create a new 'Maybe Manager', should the user have -- chosen to use one. startUVMeter :: String -- ^ Station -> [String] -- ^ User supplied arguments -> Int -- ^ Update rate -> (String -> IO ()) -> IO () startUVMeter station args = runM (station : args) uvConfig runUVMeter runUVMeter :: [String] -> Monitor String runUVMeter [] = return "N.A." runUVMeter (s:_) = do man <- io getGlobalManager resp <- io $ getData man case textToXMLDocument resp of Right doc -> formatUVRating (getUVRating s doc) Left _ -> getConfigValue naString -- | XML Parsing code comes here. -- This is a very simple XML parser to just deal with the uvvalues.xml -- provided by ARPANSA. If you work on a new plugin which needs an XML -- parser perhaps consider using a real XML parser and refactor this -- plug-in to us it as well. -- -- Note: This parser can not deal with short tags. -- -- Kudos to: Charlie Harvey for his article about writing an XML Parser -- with Parsec. -- type AttrName = String type AttrValue = String newtype Attribute = Attribute (AttrName, AttrValue) deriving (Show) data XML = Element String [Attribute] [XML] | Decl String | Body String deriving (Show) -- | parse the document -- document :: Parser [XML] document = do spaces y <- try xmlDecl <|> tag spaces x <- many tag spaces return (y : x) -- | parse any tags -- tag :: Parser XML tag = do char '<' spaces name <- many (letter <|> digit) spaces attr <- many attribute spaces string ">" eBody <- many elementBody endTag name spaces return (Element name attr eBody) xmlDecl :: Parser XML xmlDecl = do void $ manyTill anyToken (string "<?xml") -- ignore the byte order mark decl <- many (noneOf "?>") string "?>" return (Decl decl) elementBody :: Parser XML elementBody = spaces *> try tag <|> text endTag :: String -> Parser String endTag str = string "</" *> string str <* char '>' text :: Parser XML text = Body <$> many1 (noneOf "><") attribute :: Parser Attribute attribute = do name <- many (noneOf "= />") spaces char '=' spaces char '"' value <- many (noneOf "\"") char '"' spaces return (Attribute (name, value)) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Uptime.hs���������������������������������������������������0000644�0000000�0000000�00000002643�07346545000�020202� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-#LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | -- Module : Plugins.Monitors.Uptime -- Copyright : (c) 2010 Jose Antonio Ortega Ruiz -- License : BSD3-style (see LICENSE) -- -- Maintainer : jao@gnu.org -- Stability : unstable -- Portability : unportable -- Created: Sun Dec 12, 2010 20:26 -- -- -- Uptime -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Monitors.Uptime (uptimeConfig, runUptime) where import Xmobar.Plugins.Monitors.Common #if defined(freebsd_HOST_OS) import qualified Xmobar.Plugins.Monitors.Uptime.FreeBSD as MU #else import qualified Xmobar.Plugins.Monitors.Uptime.Linux as MU #endif uptimeConfig :: IO MConfig uptimeConfig = mkMConfig "Up <days>d <hours>h <minutes>m" ["days", "hours", "minutes", "seconds"] secsPerDay :: Integer secsPerDay = 24 * 3600 uptime :: Monitor [String] uptime = do t <- io MU.readUptime u <- getConfigValue useSuffix let tsecs = floor t secs = tsecs `mod` secsPerDay days = tsecs `quot` secsPerDay hours = secs `quot` 3600 mins = (secs `mod` 3600) `div` 60 ss = secs `mod` 60 str x s = if u then show x ++ s else show x mapM (`showWithColors'` days) [str days "d", str hours "h", str mins "m", str ss "s"] runUptime :: [String] -> Monitor String runUptime _ = uptime >>= parseTemplate ���������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Uptime/�����������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�017641� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Uptime/FreeBSD.hsc������������������������������������������0000644�0000000�0000000�00000002462�07346545000�021556� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module : Plugins.Monitors.Uptime.FreeBSD -- Copyright : (c) 2010 Jose Antonio Ortega Ruiz -- License : BSD3-style (see LICENSE) -- -- Maintainer : jao@gnu.org -- Stability : unstable -- Portability : unportable -- Created: Sun Dec 12, 2010 20:26 -- -- -- Uptime -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Monitors.Uptime.FreeBSD (readUptime) where import Data.Time.Clock.POSIX (getPOSIXTime) import System.BSD.Sysctl import Data.Int import Foreign.C import Foreign.Storable #include <sys/types.h> #include <sys/user.h> #include <sys/time.h> #include <sys/sysctl.h> data TimeVal = TimeVal {sec:: CTime} instance Storable TimeVal where sizeOf _ = #{size struct timeval} alignment _ = alignment (undefined::CTime) peek ptr = do cSec <- #{peek struct timeval, tv_sec} ptr return (TimeVal cSec) poke _ _ = pure () now :: IO Int64 now = do posix <- getPOSIXTime return $ round posix readUptime :: IO Float readUptime = do tv <- sysctlPeek "kern.boottime" :: IO TimeVal nowSec <- now return $ fromInteger $ toInteger $ (nowSec - (secInt $ sec tv)) where secInt :: CTime -> Int64 secInt (CTime cSec) = cSec ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Uptime/Linux.hs���������������������������������������������0000644�0000000�0000000�00000001231�07346545000�021271� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module : Plugins.Monitors.Uptime.Linux -- Copyright : (c) 2010 Jose Antonio Ortega Ruiz -- License : BSD3-style (see LICENSE) -- -- Maintainer : jao@gnu.org -- Stability : unstable -- Portability : unportable -- Created: Sun Dec 12, 2010 20:26 -- -- -- Uptime -- ------------------------------------------------------------------------------ module Xmobar.Plugins.Monitors.Uptime.Linux (readUptime) where import qualified Data.ByteString.Lazy.Char8 as B readUptime :: IO Float readUptime = fmap (read . B.unpack . head . B.words) (B.readFile "/proc/uptime") �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Volume.hs���������������������������������������������������0000644�0000000�0000000�00000021630�07346545000�020203� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Volume -- Copyright : (c) 2011, 2013, 2015, 2018, 2020 Thomas Tuegel -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A monitor for ALSA soundcards -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Volume ( runVolume , runVolumeWith , volumeConfig , options , defaultOpts , VolumeOpts ) where import Control.Applicative ( liftA3 ) import Control.Monad ( liftM2, liftM3, mplus ) import Xmobar.Plugins.Monitors.Common import Sound.ALSA.Mixer import qualified Sound.ALSA.Exception as AE import System.Console.GetOpt volumeConfig :: IO MConfig volumeConfig = mkMConfig "Vol: <volume>% <status>" [ "volume" , "volumebar" , "volumevbar" , "dB" , "status" , "volumeipat" , "volumestatus" ] data VolumeOpts = VolumeOpts { onString :: String , offString :: String , onColor :: Maybe String , offColor :: Maybe String , highDbThresh :: Float , lowDbThresh :: Float , volumeIconPattern :: Maybe IconPattern , lowVolThresh :: Maybe Float , highVolThresh :: Maybe Float , lowString :: String , mediumString :: String , highString :: String } defaultOpts :: VolumeOpts defaultOpts = VolumeOpts { onString = "[on] " , offString = "[off]" , onColor = Just "green" , offColor = Just "red" , highDbThresh = -5.0 , lowDbThresh = -30.0 , volumeIconPattern = Nothing , lowVolThresh = Just 20.0 , highVolThresh = Just 60.0 , lowString = "" , mediumString = "" , highString = "" } data VolumeStatus = VolLow | VolMedium | VolHigh | VolOff -- | Set the volume status according to user set thresholds and the current -- volume getVolStatus :: Float -- ^ Low volume threshold, in [0,100] -> Float -- ^ High volume threshold, in [0,100] -> Float -- ^ Current volume, in [0,1] -> VolumeStatus getVolStatus lo hi val' | val >= hi = VolHigh | val >= lo = VolMedium | otherwise = VolLow where val = val' * 100 options :: [OptDescr (VolumeOpts -> VolumeOpts)] options = [ Option "O" ["on"] (ReqArg (\x o -> o { onString = x }) "") "" , Option "o" ["off"] (ReqArg (\x o -> o { offString = x }) "") "" , Option "" ["lowd"] (ReqArg (\x o -> o { lowDbThresh = read x }) "") "" , Option "" ["highd"] (ReqArg (\x o -> o { highDbThresh = read x }) "") "" , Option "C" ["onc"] (ReqArg (\x o -> o { onColor = Just x }) "") "" , Option "c" ["offc"] (ReqArg (\x o -> o { offColor = Just x }) "") "" , Option "" ["volume-icon-pattern"] (ReqArg (\x o -> o { volumeIconPattern = Just $ parseIconPattern x }) "") "" , Option "L" ["lowv"] (ReqArg (\x o -> o { lowVolThresh = Just $ read x }) "") "" , Option "H" ["highv"] (ReqArg (\x o -> o { highVolThresh = Just $ read x }) "") "" , Option "l" ["lows"] (ReqArg (\x o -> o { lowString = x }) "") "" , Option "m" ["mediums"] (ReqArg (\x o -> o { mediumString = x }) "") "" , Option "h" ["highs"] (ReqArg (\x o -> o { highString = x }) "") "" ] percent :: Integer -> Integer -> Integer -> Float percent v' lo' hi' = (v - lo) / (hi - lo) where v = fromIntegral v' lo = fromIntegral lo' hi = fromIntegral hi' formatVol :: Integer -> Integer -> Integer -> Monitor String formatVol lo hi v = showPercentWithColors $ percent v lo hi formatVolBar :: Integer -> Integer -> Integer -> Monitor String formatVolBar lo hi v = showPercentBar (100 * x) x where x = percent v lo hi formatVolVBar :: Integer -> Integer -> Integer -> Monitor String formatVolVBar lo hi v = showVerticalBar (100 * x) x where x = percent v lo hi formatVolDStr :: Maybe IconPattern -> Integer -> Integer -> Integer -> Monitor String formatVolDStr ipat lo hi v = showIconPattern ipat $ percent v lo hi switchHelper :: VolumeOpts -> (VolumeOpts -> Maybe String) -> (VolumeOpts -> String) -> VolumeStatus -> Monitor String switchHelper opts cHelp strHelp vs = return $ colorHelper (cHelp opts) ++ volHelper vs opts ++ strHelp opts ++ maybe "" (const "</fc>") (cHelp opts) formatSwitch :: VolumeOpts -> Bool -> VolumeStatus -> Monitor String formatSwitch opts True vs = switchHelper opts onColor onString vs formatSwitch opts False _ = switchHelper opts offColor offString VolOff -- | Convert the current volume status into user defined strings volHelper :: VolumeStatus -> VolumeOpts -> String volHelper volStatus opts = case volStatus of VolHigh -> highString opts VolMedium -> mediumString opts VolLow -> lowString opts VolOff -> "" colorHelper :: Maybe String -> String colorHelper = maybe "" (\c -> "<fc=" ++ c ++ ">") formatDb :: VolumeOpts -> Integer -> Monitor String formatDb opts dbi = do h <- getConfigValue highColor m <- getConfigValue normalColor l <- getConfigValue lowColor d <- getConfigValue decDigits let db = fromIntegral dbi / 100.0 digits = showDigits d db startColor | db >= highDbThresh opts = colorHelper h | db < lowDbThresh opts = colorHelper l | otherwise = colorHelper m stopColor | null startColor = "" | otherwise = "</fc>" return $ startColor ++ digits ++ stopColor runVolume :: String -> String -> [String] -> Monitor String runVolume mixerName controlName argv = do opts <- io $ parseOptsWith options defaultOpts argv runVolumeWith opts mixerName controlName runVolumeWith :: VolumeOpts -> String -> String -> Monitor String runVolumeWith opts mixerName controlName = do (lo, hi, val, db, sw) <- io readMixer p <- liftMonitor $ liftM3 formatVol lo hi val b <- liftMonitor $ liftM3 formatVolBar lo hi val v <- liftMonitor $ liftM3 formatVolVBar lo hi val d <- getFormatDB opts db let volStat = liftA3 getVolStatus (lowVolThresh opts) (highVolThresh opts) (liftA3 percent val lo hi) -- current volume in % s <- getFormatSwitch opts sw volStat ipat <- liftMonitor $ liftM3 (formatVolDStr $ volumeIconPattern opts) lo hi val -- Volume and status in one. let vs = if isVolOff sw then offString opts -- User defined off string else s ++ p -- Status string, current volume in % parseTemplate [p, b, v, d, s, ipat, vs] where readMixer = AE.catch (withMixer mixerName $ \mixer -> do control <- getControlByName mixer controlName (lo, hi) <- liftMaybe $ getRange <$> volumeControl control val <- getVal $ volumeControl control db <- getDB $ volumeControl control sw <- getSw $ switchControl control return (fmap toInteger lo, fmap toInteger hi, val, db, sw)) (const $ return (Nothing, Nothing, Nothing, Nothing, Nothing)) volumeControl :: Maybe Control -> Maybe Volume volumeControl c = (playback . volume =<< c) `mplus` (capture . volume =<< c) `mplus` (common . volume =<< c) switchControl :: Maybe Control -> Maybe Switch switchControl c = (playback . switch =<< c) `mplus` (capture . switch =<< c) `mplus` (common . switch =<< c) liftMaybe :: Maybe (IO (a,b)) -> IO (Maybe a, Maybe b) liftMaybe = fmap (liftM2 (,) (fmap fst) (fmap snd)) . sequenceA liftMonitor :: Maybe (Monitor String) -> Monitor String liftMonitor Nothing = unavailable liftMonitor (Just m) = m channel' :: PerChannel a -> IO (Maybe a) channel' v = AE.catch (getChannel FrontLeft v) (const (return Nothing)) channel :: PerChannel CLong -> IO (Maybe Integer) channel v = fmap (fmap toInteger) (channel' v) getDB :: Maybe Volume -> IO (Maybe Integer) getDB Nothing = return Nothing getDB (Just v) = channel (dB v) getVal :: Maybe Volume -> IO (Maybe Integer) getVal Nothing = return Nothing getVal (Just v) = channel (value v) getSw :: Maybe Switch -> IO (Maybe Bool) getSw Nothing = return Nothing getSw (Just s) = channel' s getFormatDB :: VolumeOpts -> Maybe Integer -> Monitor String getFormatDB _ Nothing = unavailable getFormatDB opts' (Just d) = formatDb opts' d getFormatSwitch :: VolumeOpts -> Maybe Bool -> Maybe VolumeStatus -> Monitor String getFormatSwitch _ Nothing _ = unavailable getFormatSwitch _ _ Nothing = unavailable getFormatSwitch opts' (Just sw) (Just vs) = formatSwitch opts' sw vs -- | Determine whether the volume is off based on the value of 'sw' from -- 'runVolumeWith'. isVolOff = (Just True /=) unavailable = getConfigValue naString ��������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Weather.hs��������������������������������������������������0000644�0000000�0000000�00000023271�07346545000�020336� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Weather -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A weather monitor for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Weather where import Xmobar.Plugins.Monitors.Common import qualified Control.Exception as CE import qualified Data.ByteString.Lazy.Char8 as B import Data.Char (toLower) import Network.HTTP.Conduit import Network.HTTP.Types.Status import Network.HTTP.Types.Method import Network.HTTP.Client.TLS (getGlobalManager) import Text.ParserCombinators.Parsec import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option)) -- | Options the user may specify. newtype WeatherOpts = WeatherOpts { weatherString :: String } -- | Default values for options. defaultOpts :: WeatherOpts defaultOpts = WeatherOpts { weatherString = "" } -- | Apply options. options :: [OptDescr (WeatherOpts -> WeatherOpts)] options = [ Option "w" ["weathers" ] (ReqArg (\s o -> o { weatherString = s }) "") "" ] weatherConfig :: IO MConfig weatherConfig = mkMConfig "<station>: <tempC>C, rh <rh>% (<hour>)" -- template ["station" -- available replacements , "stationState" , "year" , "month" , "day" , "hour" , "windCardinal" , "windAzimuth" , "windMph" , "windKnots" , "windKmh" , "windMs" , "visibility" , "skyCondition" , "skyConditionS" , "weather" , "tempC" , "tempF" , "dewPointC" , "dewPointF" , "rh" , "pressure" ] data WindInfo = WindInfo { windCardinal :: String -- cardinal direction , windAzimuth :: String -- azimuth direction , windMph :: String -- speed (MPH) , windKnots :: String -- speed (knot) , windKmh :: String -- speed (km/h) , windMs :: String -- speed (m/s) } deriving (Show) data WeatherInfo = WI { stationPlace :: String , stationState :: String , year :: String , month :: String , day :: String , hour :: String , windInfo :: WindInfo , visibility :: String , skyCondition :: String , weather :: String , tempC :: Int , tempF :: Int , dewPointC :: Int , dewPointF :: Int , humidity :: Int , pressure :: Int } deriving (Show) pTime :: Parser (String, String, String, String) pTime = do y <- getNumbersAsString char '.' m <- getNumbersAsString char '.' d <- getNumbersAsString char ' ' (h:hh:mi:mimi) <- getNumbersAsString char ' ' return (y, m, d ,h:hh:":"++mi:mimi) noWind :: WindInfo noWind = WindInfo "μ" "μ" "0" "0" "0" "0" pWind :: Parser WindInfo pWind = let tospace = manyTill anyChar (char ' ') toKmh knots = knots $* 1.852 toMs knots = knots $* 0.514 ($*) :: String -> Double -> String op1 $* op2 = show (round ((read op1::Double) * op2)::Integer) -- Occasionally there is no wind and a METAR report gives simply, "Wind: Calm:0" wind0 = do manyTill skipRestOfLine (string "Wind: Calm:0") return noWind windVar = do manyTill skipRestOfLine (string "Wind: Variable at ") mph <- tospace string "MPH (" knot <- tospace manyTill anyChar newline return $ WindInfo "μ" "μ" mph knot (toKmh knot) (toMs knot) wind = do manyTill skipRestOfLine (string "Wind: from the ") cardinal <- tospace char '(' azimuth <- tospace string "degrees) at " mph <- tospace string "MPH (" knot <- tospace manyTill anyChar newline return $ WindInfo cardinal azimuth mph knot (toKmh knot) (toMs knot) in try wind0 <|> try windVar <|> try wind <|> return noWind pTemp :: Parser (Int, Int) pTemp = do let num = digit <|> char '-' <|> char '.' f <- manyTill num $ char ' ' manyTill anyChar $ char '(' c <- manyTill num $ char ' ' skipRestOfLine return (floor (read c :: Double), floor (read f :: Double)) pRh :: Parser Int pRh = do s <- manyTill digit (char '%' <|> char '.') return $ read s pPressure :: Parser Int pPressure = do manyTill anyChar $ char '(' s <- manyTill digit $ char ' ' skipRestOfLine return $ read s {- example of 'http://weather.noaa.gov/pub/data/observations/metar/decoded/VTUD.TXT': Station name not available Aug 11, 2013 - 10:00 AM EDT / 2013.08.11 1400 UTC Wind: from the N (350 degrees) at 1 MPH (1 KT):0 Visibility: 4 mile(s):0 Sky conditions: mostly clear Temperature: 77 F (25 C) Dew Point: 73 F (23 C) Relative Humidity: 88% Pressure (altimeter): 29.77 in. Hg (1008 hPa) ob: VTUD 111400Z 35001KT 8000 FEW030 25/23 Q1008 A2977 INFO R RWY30 cycle: 14 -} parseData :: Parser [WeatherInfo] parseData = do (st, ss) <- try (string "Station name not available" >> return ("??", "??")) <|> (do st <- getAllBut "," space ss <- getAllBut "(" return (st, ss) ) skipRestOfLine >> getAllBut "/" (y,m,d,h) <- pTime w <- pWind v <- getAfterString "Visibility: " sk <- getAfterString "Sky conditions: " we <- getAfterString "Weather: " skipTillString "Temperature: " (tC,tF) <- pTemp skipTillString "Dew Point: " (dC, dF) <- pTemp skipTillString "Relative Humidity: " rh <- pRh skipTillString "Pressure (altimeter): " p <- pPressure manyTill skipRestOfLine eof return [WI st ss y m d h w v sk we tC tF dC dF rh p] defUrl :: String defUrl = "https://tgftp.nws.noaa.gov/data/observations/metar/decoded/" stationUrl :: String -> String stationUrl station = defUrl ++ station ++ ".TXT" -- | Get the decoded weather data from the given station. getData :: String -> IO String getData station = CE.catch (do request <- parseUrlThrow $ stationUrl station man <- getGlobalManager res <- httpLbs request man return $ B.unpack $ responseBody res) errHandler where errHandler :: CE.SomeException -> IO String errHandler _ = return "<Could not retrieve data>" formatSk :: Eq p => [(p, p)] -> p -> p formatSk ((a,b):sks) sk = if a == sk then b else formatSk sks sk formatSk [] sk = sk formatWeather :: WeatherOpts -- ^ Formatting options from the cfg file -> [(String,String)] -- ^ 'SkyConditionS' for 'WeatherX' -> [WeatherInfo] -- ^ The actual weather info -> Monitor String formatWeather opts sks [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk we tC tF dC dF r p] = do cel <- showWithColors show tC far <- showWithColors show tF let sk' = formatSk sks (map toLower sk) we' = showWeather (weatherString opts) we parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, wkh , wms, v, sk, sk', we', cel, far , show dC, show dF, show r , show p ] formatWeather _ _ _ = getConfigValue naString -- | Show the 'weather' field with a default string in case it was empty. showWeather :: String -> String -> String showWeather "" d = d showWeather s _ = s -- | Start a weather monitor, create a new 'Maybe Manager', should the user have -- chosen to use one. startWeather' :: [(String, String)] -- ^ 'SkyConditionS' replacement strings -> String -- ^ Weather station -> [String] -- ^ User supplied arguments -> Int -- ^ Update rate -> (String -> IO ()) -> IO () startWeather' sks station args rate cb = do opts <- parseOptsWith options defaultOpts (getArgvs args) runMD (station : args) weatherConfig (runWeather sks opts) rate weatherReady cb -- | Same as 'startWeather'', only for 'Weather' instead of 'WeatherX', meaning -- no 'SkyConditionS'. startWeather :: String -> [String] -> Int -> (String -> IO ()) -> IO () startWeather = startWeather' [] -- | Run a weather monitor. runWeather :: [(String, String)] -- ^ 'SkyConditionS' replacement strings -> WeatherOpts -- ^ Weather specific options -> [String] -- ^ User supplied arguments -> Monitor String runWeather sks opts args = do d <- io $ getData (head args) i <- io $ runP parseData d formatWeather opts sks i weatherReady :: [String] -> Monitor Bool weatherReady str = io $ do initRequest <- parseUrlThrow $ stationUrl $ head str let request = initRequest { method = methodHead } CE.catch (do man <- getGlobalManager res <- httpLbs request man return $ checkResult $ responseStatus res) errHandler where -- | If any exception occurs, indicate that the monitor is not ready. errHandler :: CE.SomeException -> IO Bool errHandler _ = return False -- | Check for and indicate any errors in the http response. checkResult :: Status -> Bool checkResult status | statusIsServerError status = False | statusIsClientError status = False | otherwise = True ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/Monitors/Wireless.hs�������������������������������������������������0000644�0000000�0000000�00000011214�07346545000�020526� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} #ifdef USE_NL80211 {-# LANGUAGE TypeApplications #-} #endif ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Wireless -- Copyright : (c) Jose Antonio Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose Antonio Ortega Ruiz -- Stability : unstable -- Portability : unportable -- -- A monitor reporting SSID and signal level for wireless interfaces -- ----------------------------------------------------------------------------- module Xmobar.Plugins.Monitors.Wireless (wirelessConfig, runWireless) where import System.Console.GetOpt import Xmobar.Plugins.Monitors.Common #ifdef IWLIB import Network.IWlib #elif defined USE_NL80211 import Control.Exception (bracket) import qualified Data.Map as M import GHC.Int (Int8) import Data.Maybe (listToMaybe, fromMaybe) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Data.ByteString.Char8 (unpack) import Data.Serialize.Put (runPut, putWord32host, putByteString) import Data.Serialize.Get (runGet) import System.Linux.Netlink hiding (query) import System.Linux.Netlink.GeNetlink.NL80211 import System.Linux.Netlink.GeNetlink.NL80211.StaInfo import System.Linux.Netlink.GeNetlink.NL80211.Constants import System.Posix.IO (closeFd) data IwData = IwData { wiEssid :: String, wiSignal :: Maybe Int, wiQuality :: Int } getWirelessInfo :: String -> IO IwData getWirelessInfo ifname = bracket makeNL80211Socket (closeFd . getFd) (\s -> do iflist <- getInterfaceList s iwdata <- runMaybeT $ do ifidx <- MaybeT . return $ foldr (\(n, i) z -> if ifname == "" || ifname == n then Just i else z) Nothing iflist scanp <- liftIO (getConnectedWifi s ifidx) >>= MaybeT . return . listToMaybe bssid <- MaybeT . return $ M.lookup eNL80211_ATTR_BSS (packetAttributes scanp) >>= rightToMaybe . runGet getAttributes >>= M.lookup eNL80211_BSS_BSSID stap <- liftIO (query s eNL80211_CMD_GET_STATION True $ M.fromList [(eNL80211_ATTR_IFINDEX, runPut $ putWord32host ifidx), (eNL80211_ATTR_MAC, runPut $ putByteString bssid)]) >>= MaybeT . return . listToMaybe let ssid = fromMaybe "" $ getWifiAttributes scanp >>= M.lookup eWLAN_EID_SSID >>= return . unpack signal = staInfoFromPacket stap >>= staSignalMBM >>= return . fromIntegral @Int8 . fromIntegral qlty = maybe (-1) (round @Float . (/ 0.7) . (+ 110) . clamp (-110) (-40) . fromIntegral) signal MaybeT . return $ Just $ IwData ssid signal qlty return $ fromMaybe (IwData "" Nothing (-1)) iwdata) where rightToMaybe = either (const Nothing) Just clamp lb up v | v < lb = lb | v > up = up | otherwise = v #endif newtype WirelessOpts = WirelessOpts { qualityIconPattern :: Maybe IconPattern } defaultOpts :: WirelessOpts defaultOpts = WirelessOpts { qualityIconPattern = Nothing } options :: [OptDescr (WirelessOpts -> WirelessOpts)] options = [ Option "" ["quality-icon-pattern"] (ReqArg (\d opts -> opts { qualityIconPattern = Just $ parseIconPattern d }) "") "" ] wirelessConfig :: IO MConfig wirelessConfig = mkMConfig "<ssid> <quality>" ["ssid", "essid", "signal", "quality", "qualitybar", "qualityvbar", "qualityipat"] runWireless :: String -> [String] -> Monitor String runWireless iface args = do opts <- io $ parseOptsWith options defaultOpts args #ifdef IWLIB iface' <- if "" == iface then io findInterface else return iface #else let iface' = iface #endif wi <- io $ getWirelessInfo iface' na <- getConfigValue naString let essid = wiEssid wi qlty = fromIntegral $ wiQuality wi e = if essid == "" then na else essid ep <- showWithPadding e #ifdef USE_NL80211 let s = wiSignal wi #else let s = if qlty >= 0 then Just (qlty * 0.7 - 110) else Nothing #endif sp <- showWithPadding $ maybe "" show s q <- if qlty >= 0 then showPercentWithColors (qlty / 100) else showWithPadding "" qb <- showPercentBar qlty (qlty / 100) qvb <- showVerticalBar qlty (qlty / 100) qipat <- showIconPattern (qualityIconPattern opts) (qlty / 100) parseTemplate [ep, ep, sp, q, qb, qvb, qipat] #ifdef IWLIB findInterface :: IO String findInterface = do c <- readFile "/proc/net/wireless" let nds = lines c return $ if length nds > 2 then takeWhile (/= 'c') (nds!!2) else [] #endif ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/NotmuchMail.hs�������������������������������������������������������0000644�0000000�0000000�00000010120�07346545000�017332� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE InstanceSigs #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE ScopedTypeVariables #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Plugins.NotmuchMail -- Copyright : (c) slotThe -- License : BSD-style (see LICENSE) -- -- Maintainer : slotThe <soliditsallgood@mailbox.org> -- Stability : unstable -- Portability : unportable -- -- This plugin checks for new mail, provided that this mail is indexed -- by @notmuch@. You can think of it as a thin wrapper around the -- functionality provided by @notmuch search@. -- -- As mail that was tagged is moved from the @new@ directory to @cur@, -- the @inotify@ solution that he mail 'Mail' plugin (and its variants) -- uses won't work for such mail. Hence, we have to resort to a -- refresh-based monitor. -- -- Note that, in the `notmuch` spirit, this plugin checks for new -- threads and not new individual messages. For convenience, the -- @unread@ tag is added before the user query (compose via an @and@). -- ----------------------------------------------------------------------------- module Xmobar.Plugins.NotmuchMail ( -- * Types MailItem(..) -- instances: Read, Show , NotmuchMail(..) -- instances: Read, Show ) where import Xmobar.Run.Exec (Exec(alias, rate, run)) import Control.Concurrent.Async (mapConcurrently) import Data.Maybe (catMaybes) import System.Exit (ExitCode(ExitSuccess)) import System.Process (readProcessWithExitCode) import Text.Read (Lexeme(Ident), ReadPrec, lexP, parens, prec, readPrec, reset) -- | A 'MailItem' is a name, an address, and a query to give to @notmuch@. data MailItem = MailItem { name :: String -- ^ Display name for the item in the bar , address :: String -- ^ Only check for mail sent to this address; may be -- the empty string to query all indexed mail instead , query :: String -- ^ Query to give to @notmuch search@ } deriving (Show) instance Read MailItem where readPrec :: ReadPrec MailItem readPrec = parens . prec 11 $ do Ident "MailItem" <- lexP MailItem <$> reset readPrec <*> reset readPrec <*> reset readPrec -- | A full mail configuration. data NotmuchMail = NotmuchMail { nmAlias :: String -- ^ Alias for the template string , mailItems :: [MailItem] -- ^ 'MailItem's to check , nmRate :: Int -- ^ Update frequency (in deciseconds) } deriving (Show) instance Read NotmuchMail where readPrec :: ReadPrec NotmuchMail readPrec = parens . prec 11 $ do Ident "NotmuchMail" <- lexP NotmuchMail <$> reset readPrec <*> reset readPrec <*> reset readPrec -- | How to execute this plugin. instance Exec NotmuchMail where -- | How often to update the plugin (in deciseconds). rate :: NotmuchMail -> Int rate NotmuchMail{ nmRate } = nmRate -- | How to alias the plugin in the template string. alias :: NotmuchMail -> String alias NotmuchMail{ nmAlias } = nmAlias -- | Run the plugin exactly once. run :: NotmuchMail -> IO String run NotmuchMail{ mailItems } = unwords . catMaybes <$> mapConcurrently notmuchSpawn mailItems where -- | Given a single 'MailItem', shell out to @notmuch@ and get the number -- of unread mails, then decide whether what we have is worth printing. notmuchSpawn :: MailItem -> IO (Maybe String) = \MailItem{ address, name, query } -> do -- Shell out to @notmuch@ let args = [ "search" , tryAdd "to:" address , "tag:unread", tryAdd "and " query ] (exitCode, out, _) <- readProcessWithExitCode "notmuch" args [] -- Only print something when there is at least _some_ new mail let numThreads = length (lines out) pure $! (name <>) . show <$> if exitCode /= ExitSuccess || numThreads < 1 then Nothing else Just numThreads -- | Only add something to a 'String' if it's not empty. tryAdd :: String -> String -> String = \prefix str -> if null str then "" else prefix <> str ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Plugins/PipeReader.hs��������������������������������������������������������0000644�0000000�0000000�00000002744�07346545000�017147� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Plugins.PipeReader -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A plugin for reading from named pipes -- ----------------------------------------------------------------------------- module Xmobar.Plugins.PipeReader(PipeReader(..)) where import System.IO import Xmobar.Run.Exec(Exec(..)) import Xmobar.System.Environment(expandEnv) import System.Posix.Files import Control.Concurrent(threadDelay) import Control.Exception import Control.Monad(forever, unless) data PipeReader = PipeReader String String deriving (Read, Show) instance Exec PipeReader where alias (PipeReader _ a) = a start (PipeReader p _) cb = do (def, pipe) <- split ':' <$> expandEnv p unless (null def) (cb def) checkPipe pipe h <- openFile pipe ReadWriteMode forever (hGetLine h >>= cb) where split c xs | c `elem` xs = let (pre, post) = span (c /=) xs in (pre, dropWhile (c ==) post) | otherwise = ([], xs) checkPipe :: FilePath -> IO () checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do status <- getFileStatus file unless (isNamedPipe status) waitForPipe where waitForPipe = threadDelay 1000000 >> checkPipe file ����������������������������xmobar-0.46/src/Xmobar/Plugins/QueueReader.hs�������������������������������������������������������0000644�0000000�0000000�00000002766�07346545000�017342� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE RecordWildCards #-} module Xmobar.Plugins.QueueReader (QueueReader (..) ) where import Xmobar.Run.Exec (Exec (..)) import Control.Monad (forever) import qualified Control.Concurrent.STM as STM -- | A 'QueueReader' displays data from an 'TQueue a' where -- the data items 'a' are rendered by a user supplied function. -- -- Like the 'HandleReader' plugin this is only useful if you are -- running @xmobar@ from other Haskell code. You should create a -- new @TQueue a@ and pass it to this plugin. -- -- @ -- main :: IO -- main = do -- q <- STM.newQueueIO @String -- bar <- forkIO $ xmobar conf -- { commands = Run (QueueReader q id "Queue") : commands conf } -- STM.atomically $ STM.writeTQueue q "Some Message" -- @ data QueueReader a = QueueReader { qQueue :: STM.TQueue a , qShowItem :: a -> String , qName :: String } -- | This cannot be read back. instance Show (QueueReader a) where -- | Only show the name/alias for the queue reader. show q = "QueueReader " <> qName q -- | WARNING: This read instance will throw an exception if used! It is -- only implemented, because it is required by 'Xmobar.Run` in 'Xmobar.commands'. instance Read (QueueReader a) where -- | Throws an 'error'! readsPrec = error "QueueReader: instance is a stub" -- | Async queue/channel reading. instance Exec (QueueReader a) where -- | Read from queue as data arrives. start QueueReader{..} cb = forever (STM.atomically (qShowItem <$> STM.readTQueue qQueue) >>= cb) alias = qName ����������xmobar-0.46/src/Xmobar/Plugins/StdinReader.hs�������������������������������������������������������0000644�0000000�0000000�00000003722�07346545000�017330� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.StdinReader -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A plugin for reading from `stdin`. -- -- Exports: -- - `StdinReader` to safely display stdin content (striping actions). -- - `UnsafeStdinReader` to display stdin content as-is. -- ----------------------------------------------------------------------------- module Xmobar.Plugins.StdinReader (StdinReader(..)) where import Prelude import System.Posix.Process import System.Exit import System.IO import System.IO.Error (isEOFError) import Xmobar.Run.Exec import Xmobar.Run.Actions (stripActions) import Control.Exception import Control.Monad (forever) data StdinReader = StdinReader | UnsafeStdinReader deriving (Read, Show) instance Exec StdinReader where start stdinReader cb = forever $ (cb . escape stdinReader =<< getLine) `catch` handler where -- rethrow async exceptions like ThreadKilled, etc. handler (fromException -> Just e) = throwIO (e :: SomeAsyncException) -- XMonad.Hooks.DynamicLog.statusBar starts new xmobar on every xmonad -- reload and the old xmobar is only signalled to exit via the pipe -- being closed, so we must unconditionally terminate on EOF, otherwise -- there'd be a pileup of xmobars handler (fromException -> Just e) | isEOFError e = exitImmediately ExitSuccess -- any other exception, like "invalid argument (invalid byte sequence)", -- is logged to both stderr and the bar itself handler e = do let errorMessage = "xmobar: Received exception " <> show e hPutStrLn stderr errorMessage cb $ stripActions errorMessage escape :: StdinReader -> String -> String escape StdinReader = stripActions escape UnsafeStdinReader = id ����������������������������������������������xmobar-0.46/src/Xmobar/Plugins/XMonadLog.hs���������������������������������������������������������0000644�0000000�0000000�00000005165�07346545000�016757� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.StdinReader -- Copyright : (c) Spencer Janssen -- License : BSD-style (see LICENSE) -- -- Maintainer : Spencer Janssen <spencerjanssen@gmail.com> -- Stability : unstable -- Portability : unportable -- -- A plugin to display information from _XMONAD_LOG, specified at -- http://code.haskell.org/XMonadContrib/XMonad/Hooks/DynamicLog.hs -- ----------------------------------------------------------------------------- module Xmobar.Plugins.XMonadLog (XMonadLog(..)) where import Control.Monad import Graphics.X11 import Graphics.X11.Xlib.Extras import Xmobar.Run.Exec import Xmobar.Run.Actions (stripActions) import Codec.Binary.UTF8.String as UTF8 import Foreign.C (CChar) import Data.List (intercalate) import Xmobar.X11.Events (nextEvent') data XMonadLog = XMonadLog | UnsafeXMonadLog | XPropertyLog String | UnsafeXPropertyLog String | NamedXPropertyLog String String | UnsafeNamedXPropertyLog String String deriving (Read, Show) instance Exec XMonadLog where alias XMonadLog = "XMonadLog" alias UnsafeXMonadLog = "UnsafeXMonadLog" alias (XPropertyLog atom) = atom alias (NamedXPropertyLog _ name) = name alias (UnsafeXPropertyLog atom) = atom alias (UnsafeNamedXPropertyLog _ name) = name start x cb = do let atom = case x of XMonadLog -> "_XMONAD_LOG" UnsafeXMonadLog -> "_XMONAD_LOG" XPropertyLog a -> a UnsafeXPropertyLog a -> a NamedXPropertyLog a _ -> a UnsafeNamedXPropertyLog a _ -> a stripNL = intercalate " - " . lines sanitize = case x of UnsafeXMonadLog -> id UnsafeXPropertyLog _ -> id UnsafeNamedXPropertyLog _ _ -> id _ -> stripActions . stripNL d <- openDisplay "" xlog <- internAtom d atom False root <- rootWindow d (defaultScreen d) selectInput d root propertyChangeMask let update = do mwp <- getWindowProperty8 d xlog root maybe (return ()) (cb . sanitize . decodeCChar) mwp update allocaXEvent $ \ep -> forever $ do nextEvent' d ep e <- getEvent ep case e of PropertyEvent { ev_atom = a } | a == xlog -> update _ -> return () return () decodeCChar :: [CChar] -> String decodeCChar = UTF8.decode . map fromIntegral �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/�������������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�013707� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/Actions.hs���������������������������������������������������������������0000644�0000000�0000000�00000002526�07346545000�015650� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Xmobar.Run.Actions -- Copyright : (c) Alexander Polakov -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- ----------------------------------------------------------------------------- module Xmobar.Run.Actions ( Button , Action(..) , runAction , runAction' , stripActions) where import System.Process (system) import Control.Monad (void) import Text.Regex (Regex, subRegex, mkRegex, matchRegex) import Data.Word (Word32) type Button = Word32 data Action = Spawn [Button] String deriving (Eq, Read, Show) runAction :: Action -> IO () runAction (Spawn _ s) = void $ system (s ++ "&") -- | Run action with stdout redirected to stderr runAction' :: Action -> IO () runAction' (Spawn _ s) = void $ system (s ++ " 1>&2 &") stripActions :: String -> String stripActions s = case matchRegex actionRegex s of Nothing -> s Just _ -> stripActions strippedOneLevel where strippedOneLevel = subRegex actionRegex s "[action=\\1\\2]\\3[/action]" actionRegex :: Regex actionRegex = mkRegex "<action=`?([^>`]*)`?( +button=[12345]+)?>(.+)</action>" ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/Exec.hs������������������������������������������������������������������0000644�0000000�0000000�00000002416�07346545000�015132� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Xmobar.Exec -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- The 'Exec' class and the 'Command' data type. -- -- The 'Exec' class represents the executable types, whose constructors may -- appear in the 'Config.commands' field of the 'Config.Config' data type. -- -- The 'Command' data type is for OS commands to be run by xmobar -- ----------------------------------------------------------------------------- module Xmobar.Run.Exec (Exec (..), tenthSeconds, doEveryTenthSeconds) where import Prelude import Data.Char import Xmobar.Run.Timer (doEveryTenthSeconds, tenthSeconds) import Xmobar.System.Signal 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 where go = doEveryTenthSeconds (rate e) $ run e >>= cb trigger :: e -> (Maybe SignalType -> IO ()) -> IO () trigger _ sh = sh Nothing ��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/Loop.hs������������������������������������������������������������������0000644�0000000�0000000�00000010046�07346545000�015155� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Run.Loop -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: unportable -- Created: Fri Jan 28, 2022 03:20 -- -- -- Running a thread for each defined Command in a loop -- ------------------------------------------------------------------------------ module Xmobar.Run.Loop (LoopFunction, loop) where import Control.Concurrent (forkIO) import Control.Exception (bracket_, bracket, handle, SomeException(..)) import Control.Concurrent.STM import Control.Concurrent.Async (Async, async, cancel) import Control.Monad (guard, void, unless) import Data.Maybe (isJust) import Data.Foldable (for_) import Xmobar.System.Signal import Xmobar.Config.Types import Xmobar.Run.Runnable (Runnable) import Xmobar.Run.Exec (start, trigger, alias) import Xmobar.Run.Template import Xmobar.Run.Timer (withTimer) #ifdef DBUS import Xmobar.System.DBus #endif newRefreshLock :: IO (TMVar ()) newRefreshLock = newTMVarIO () refreshLock :: TMVar () -> IO a -> IO a refreshLock var = bracket_ lock unlock where lock = atomically $ takeTMVar var unlock = atomically $ putTMVar var () refreshLockT :: TMVar () -> STM a -> STM a refreshLockT var action = do takeTMVar var r <- action putTMVar var () return r type LoopFunction = TMVar SignalType -> TVar [String] -> IO () loop :: Config -> LoopFunction -> IO () loop conf looper = withDeferSignals $ do cls <- mapM (parseTemplate (commands conf) (sepChar conf)) (splitTemplate (alignSep conf) (template conf)) let confSig = unSignalChan (signal conf) sig <- maybe newEmptyTMVarIO pure confSig unless (isJust confSig) $ setupSignalHandler sig refLock <- newRefreshLock withTimer (refreshLock refLock) $ bracket (mapM (mapM $ startCommand sig) cls) cleanupThreads $ \vars -> do tv <- initLoop sig refLock vars looper sig tv cleanupThreads :: [[([Async ()], a)]] -> IO () cleanupThreads vars = for_ (concat vars) $ \(asyncs, _) -> for_ asyncs cancel -- | Initialises context for an event loop, returning a TVar that -- will hold the current list of values computed by commands. initLoop :: TMVar SignalType -> TMVar () -> [[([Async ()], TVar String)]] -> IO (TVar [String]) initLoop sig lock vs = do tv <- newTVarIO ([] :: [String]) _ <- forkIO (handle (handler "checker") (checker tv [] vs sig lock)) #ifdef DBUS runIPC sig #endif return tv where handler thing (SomeException e) = void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e) -- | Runs a command as an independent thread and returns its Async handles -- and the TVar the command will be writing to. startCommand :: TMVar SignalType -> (Runnable,String,String) -> IO ([Async ()], TVar String) startCommand sig (com,s,ss) | alias com == "" = do var <- newTVarIO is atomically $ writeTVar var (s ++ ss) return ([], var) | otherwise = do var <- newTVarIO is let cb str = atomically $ writeTVar var (s ++ str ++ ss) a1 <- async $ start com cb a2 <- async $ trigger com $ maybe (return ()) (atomically . putTMVar sig) return ([a1, a2], var) where is = s ++ "Updating..." ++ ss -- | Send signal to eventLoop every time a var is updated checker :: TVar [String] -> [String] -> [[([Async ()], TVar String)]] -> TMVar SignalType -> TMVar () -> IO () checker tvar ov vs sig pauser = do nval <- atomically $ refreshLockT pauser $ do nv <- mapM concatV vs guard (nv /= ov) writeTVar tvar nv return nv atomically $ putTMVar sig Wakeup checker tvar nval vs sig pauser where concatV = fmap concat . mapM (readTVar . snd) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/Runnable.hs��������������������������������������������������������������0000644�0000000�0000000�00000004106�07346545000�016012� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE ExistentialQuantification, MultiParamTypeClasses, FlexibleContexts, FlexibleInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Runnable -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- The existential type to store the list of commands to be executed. -- I must thank Claus Reinke for the help in understanding the mysteries of -- reading existential types. The Read instance of Runnable must be credited to -- him. -- -- See here: -- http:\/\/www.haskell.org\/pipermail\/haskell-cafe\/2007-July\/028227.html -- ----------------------------------------------------------------------------- module Xmobar.Run.Runnable where import Control.Monad import Text.Read import Xmobar.Run.Types (runnableTypes) import Xmobar.Run.Exec 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 trigger (Run a) = trigger a instance Show Runnable where show (Run x) = "Run " ++ show x instance Read Runnable where readPrec = readRunnable class ReadAsAnyOf ts ex where -- | Reads an existential type as any of hidden types ts readAsAnyOf :: ts -> ReadPrec ex instance ReadAsAnyOf () ex where readAsAnyOf ~() = mzero instance (Read t, Exec t, ReadAsAnyOf ts Runnable) => ReadAsAnyOf (t,ts) Runnable where readAsAnyOf ~(t,ts) = r t `mplus` readAsAnyOf ts where r ty = do { m <- readPrec; return (Run (m `asTypeOf` ty)) } -- | The 'Prelude.Read' parser for the 'Runnable' existential type. It -- needs an 'Prelude.undefined' with a type signature containing the -- list of all possible types hidden within 'Runnable'. See 'Config.runnableTypes'. -- Each hidden type must have a 'Prelude.Read' instance. readRunnable :: ReadPrec Runnable readRunnable = prec 10 $ do Ident "Run" <- lexP parens $ readAsAnyOf runnableTypes ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/Runnable.hs-boot���������������������������������������������������������0000644�0000000�0000000�00000000346�07346545000�016755� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE ExistentialQuantification #-} module Xmobar.Run.Runnable where import Xmobar.Run.Exec data Runnable = forall r . (Exec r,Read r,Show r) => Run r instance Show Runnable instance Read Runnable instance Exec Runnable ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/Template.hs��������������������������������������������������������������0000644�0000000�0000000�00000005265�07346545000�016026� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Template -- Copyright: (c) 2018 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Nov 25, 2018 05:49 -- -- -- Handling the top-level output template -- ------------------------------------------------------------------------------ module Xmobar.Run.Template(parseTemplate, splitTemplate) where import qualified Data.Map as Map import Text.ParserCombinators.Parsec import Xmobar.Plugins.Command import Xmobar.Run.Exec import Xmobar.Run.Runnable defaultAlign :: String defaultAlign = "}{" allTillSep :: String -> Parser String allTillSep = many . noneOf -- | Parses the output template string templateStringParser :: String -> Parser (String,String,String) templateStringParser sepChar = do s <- allTillSep sepChar com <- templateCommandParser sepChar ss <- allTillSep sepChar return (com, s, ss) -- | Parses the command part of the template string templateCommandParser :: String -> Parser String templateCommandParser sepChar = let chr = char (head sepChar) in between chr chr (allTillSep sepChar) -- | Combines the template parsers templateParser :: String -> Parser [(String,String,String)] templateParser s = many $ templateStringParser s -- | Actually runs the template parsers over a (segment of) a template -- string, returning a list of runnables with their prefix and suffix. parseTemplate :: [Runnable] -> String -> String -> IO [(Runnable,String,String)] parseTemplate c sepChar s = do str <- case parse (templateParser sepChar) "" s of Left _ -> return [("", s, "")] Right x -> return x let cl = map alias c m = Map.fromList $ zip cl c return $ combine c m str -- | Given a finite "Map" and a parsed template produce the resulting -- output string. combine :: [Runnable] -> Map.Map String Runnable -> [(String, String, String)] -> [(Runnable,String,String)] combine _ _ [] = [] combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs where com = Map.findWithDefault dflt ts m dflt = Run $ Com ts [] [] 10 -- | Given an two-char alignment separator and a template string, -- splits it into its segments, that can then be parsed via parseCommands splitTemplate :: String -> String -> [String] splitTemplate alignSep template = case break (==l) template of (le,_:re) -> case break (==r) re of (ce,_:ri) -> [le, ce, ri] _ -> def _ -> def where [l, r] = if length alignSep == 2 then alignSep else defaultAlign def = [template, "", ""] �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/Timer.hs�����������������������������������������������������������������0000644�0000000�0000000�00000020166�07346545000�015330� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE LambdaCase #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Run.Timer -- Copyright: (c) 2019, 2020, 2022 Tomáš Janoušek -- License: BSD3-style (see LICENSE) -- -- Maintainer: Tomáš Janoušek <tomi@nomi.cz> -- Stability: unstable -- -- Timer coalescing for recurring actions. -- ------------------------------------------------------------------------------ module Xmobar.Run.Timer ( doEveryTenthSeconds , tenthSeconds , withTimer ) where import Control.Concurrent (threadDelay) import Control.Concurrent.Async (withAsync) import Control.Concurrent.STM import Control.Exception import Control.Monad (forever, forM, guard) import Data.Foldable (foldrM, for_) import Data.Int (Int64) import Data.Map (Map) import qualified Data.Map as M import Data.Maybe (isJust, fromJust) import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Unique import System.IO.Unsafe (unsafePerformIO) type Periods = Map Unique Period data Tick = Tick (TMVar ()) | UnCoalesce data Period = Period { rate :: Int64, next :: Int64, tick :: TMVar Tick } data UnCoalesceException = UnCoalesceException deriving Show instance Exception UnCoalesceException {-# NOINLINE periodsVar #-} periodsVar :: TVar (Maybe Periods) periodsVar = unsafePerformIO $ newTVarIO Nothing now :: IO Int64 now = do posix <- getPOSIXTime return $ floor (10 * posix) newPeriod :: Int64 -> IO (Unique, Period) newPeriod r = do u <- newUnique t <- now v <- newEmptyTMVarIO let t' = t - t `mod` r return (u, Period { rate = r, next = t', tick = v }) -- | Perform a given action every N tenths of a second. -- -- The timer is aligned (coalesced) with other timers to minimize the number -- of wakeups and unnecessary redraws. If the action takes too long (one -- second or when the next timer is due), coalescing is disabled for it and it -- falls back to periodic sleep. doEveryTenthSeconds :: Int -> IO () -> IO () doEveryTenthSeconds r action = doEveryTenthSecondsCoalesced r action `catch` \UnCoalesceException -> doEveryTenthSecondsSleeping r action -- | Perform a given action every N tenths of a second, -- coalesce with other timers using a given Timer instance. doEveryTenthSecondsCoalesced :: Int -> IO () -> IO () doEveryTenthSecondsCoalesced r action = do (u, p) <- newPeriod (fromIntegral r) bracket_ (push u p) (pop u) $ forever $ bracket (wait p) done $ const action where push u p = atomically $ modifyTVar' periodsVar $ \case Just periods -> Just $ M.insert u p periods Nothing -> throw UnCoalesceException pop u = atomically $ modifyTVar' periodsVar $ \case Just periods -> Just $ M.delete u periods Nothing -> Nothing wait p = atomically (takeTMVar $ tick p) >>= \case Tick doneVar -> return doneVar UnCoalesce -> throwIO UnCoalesceException done doneVar = atomically $ putTMVar doneVar () -- | Perform a given action every N tenths of a second, -- making no attempt to synchronize with other timers. doEveryTenthSecondsSleeping :: Int -> IO () -> IO () doEveryTenthSecondsSleeping r action = go where go = action >> tenthSeconds r >> go -- | Sleep for a given amount of tenths of a second. -- -- (Work around the Int max bound: since threadDelay takes an Int, it -- is not possible to set a thread delay grater than about 45 minutes. -- With a little recursion we solve the problem.) tenthSeconds :: Int -> IO () tenthSeconds s | s >= x = do threadDelay (x * 100000) tenthSeconds (s - x) | otherwise = threadDelay (s * 100000) where x = (maxBound :: Int) `div` 100000 -- | Start the timer coordination thread and perform a given IO action (this -- is meant to surround the entire xmobar execution), terminating the timer -- thread afterwards. -- -- Additionally, if the timer thread fails, individual -- 'doEveryTenthSecondsCoalesced' invocations that are waiting to be -- coordinated by it are notified to fall back to periodic sleeping. -- -- The timer thread _will_ fail immediately when running in a non-threaded -- RTS. withTimer :: (IO () -> IO ()) -> IO a -> IO a withTimer pauseRefresh action = withAsync (timerThread `finally` cleanup) $ const action where timerThread = do atomically $ writeTVar periodsVar $ Just M.empty timerLoop pauseRefresh cleanup = atomically $ readTVar periodsVar >>= \case Just periods -> do for_ periods unCoalesceTimer' writeTVar periodsVar Nothing Nothing -> return () timerLoop :: (IO () -> IO ()) -> IO () timerLoop pauseRefresh = forever $ do tNow <- now (toFire, tMaybeNext) <- atomically $ do periods <- fromJust <$> readTVar periodsVar let toFire = timersToFire tNow periods let periods' = advanceTimers tNow periods let tMaybeNext = nextFireTime periods' writeTVar periodsVar $ Just periods' return (toFire, tMaybeNext) pauseRefresh $ do -- To avoid multiple refreshes, pause refreshing for up to 1 second, -- fire timers and wait for them to finish (update their text). -- Those that need more time (e.g. weather monitors) will be dropped -- from timer coalescing and will fall back to periodic sleep. timeoutVar <- registerDelay $ case tMaybeNext of Just tNext -> fromIntegral ((tNext - tNow) `max` 10) * 100000 Nothing -> 1000000 fired <- fireTimers toFire timeouted <- waitForTimers timeoutVar fired unCoalesceTimers timeouted delayUntilNextFire advanceTimers :: Int64 -> Periods -> Periods advanceTimers t = M.map advance where advance p | next p <= t = p { next = t - t `mod` rate p + rate p } | otherwise = p timersToFire :: Int64 -> Periods -> [(Unique, Period)] timersToFire t periods = [ (u, p) | (u, p) <- M.toList periods, next p <= t ] nextFireTime :: Periods -> Maybe Int64 nextFireTime periods | M.null periods = Nothing | otherwise = Just $ minimum [ next p | p <- M.elems periods ] fireTimers :: [(Unique, Period)] -> IO [(Unique, TMVar ())] fireTimers toFire = atomically $ forM toFire $ \(u, p) -> do doneVar <- newEmptyTMVar putTMVar (tick p) (Tick doneVar) return (u, doneVar) waitForTimers :: TVar Bool -> [(Unique, TMVar ())] -> IO [Unique] waitForTimers timeoutVar fired = atomically $ do timeoutOver <- readTVar timeoutVar dones <- forM fired $ \(u, doneVar) -> do done <- isJust <$> tryReadTMVar doneVar return (u, done) guard $ timeoutOver || all snd dones return [u | (u, False) <- dones] -- | Handle slow timers (drop and signal them to stop coalescing). unCoalesceTimers :: [Unique] -> IO () unCoalesceTimers timers = atomically $ do periods <- fromJust <$> readTVar periodsVar periods' <- foldrM unCoalesceTimer periods timers writeTVar periodsVar $ Just periods' unCoalesceTimer :: Unique -> Periods -> STM Periods unCoalesceTimer u periods = do unCoalesceTimer' (periods M.! u) return $ u `M.delete` periods unCoalesceTimer' :: Period -> STM () unCoalesceTimer' p = do _ <- tryTakeTMVar (tick p) putTMVar (tick p) UnCoalesce delayUntilNextFire :: IO () delayUntilNextFire = do Just periods <- readTVarIO periodsVar let tMaybeNext = nextFireTime periods tNow <- now delayVar <- case tMaybeNext of Just tNext -> do -- Work around the Int max bound: threadDelay takes an Int, we can -- only sleep for so long, which is okay, we'll just check timers -- sooner and sleep again. let maxDelay = (maxBound :: Int) `div` 100000 delay = (tNext - tNow) `min` fromIntegral maxDelay delayUsec = fromIntegral delay * 100000 registerDelay delayUsec Nothing -> newTVarIO False atomically $ do delayOver <- readTVar delayVar periods' <- fromJust <$> readTVar periodsVar let tMaybeNext' = nextFireTime periods' -- Return also if a new period is added (it may fire sooner). guard $ delayOver || tMaybeNext /= tMaybeNext' ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Run/Types.hs�����������������������������������������������������������������0000644�0000000�0000000�00000004063�07346545000�015352� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE TypeOperators, CPP #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Run.Types -- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Nov 25, 2018 07:17 -- -- -- An enumeration of all runnable types -- ------------------------------------------------------------------------------ module Xmobar.Run.Types(runnableTypes) where import {-# SOURCE #-} Xmobar.Run.Runnable() import Xmobar.Plugins.Command import Xmobar.Plugins.Monitors import Xmobar.Plugins.Date import Xmobar.Plugins.PipeReader import Xmobar.Plugins.BufferedPipeReader import Xmobar.Plugins.MarqueePipeReader import Xmobar.Plugins.CommandReader import Xmobar.Plugins.StdinReader import Xmobar.Plugins.XMonadLog import Xmobar.Plugins.EWMH import Xmobar.Plugins.Kbd import Xmobar.Plugins.Locks import Xmobar.Plugins.NotmuchMail #ifdef INOTIFY import Xmobar.Plugins.Mail import Xmobar.Plugins.MBox #endif #ifdef DATEZONE import Xmobar.Plugins.DateZone #endif #ifdef KRAKEN import Xmobar.Plugins.Kraken #endif -- | An alias for tuple types that is more convenient for long lists. type a :*: b = (a, b) infixr :*: -- | This is the list of types that can be hidden inside -- 'Runnable.Runnable', the existential type that stores all commands -- to be executed by Xmobar. It is used by 'Runnable.readRunnable' in -- 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 :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*: NotmuchMail :*: #ifdef INOTIFY Mail :*: MBox :*: #endif #ifdef DATEZONE DateZone :*: #endif #ifdef KRAKEN Kraken :*: #endif MarqueePipeReader :*: () runnableTypes = undefined �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/System/����������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�014427� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/System/DBus.hs���������������������������������������������������������������0000644�0000000�0000000�00000004522�07346545000�015623� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- 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 Xmobar.System.DBus (runIPC) where import DBus import DBus.Client hiding (interfaceName) import qualified DBus.Client as DC import Data.Maybe (isNothing) import Control.Concurrent.STM import Control.Exception (handle) import System.IO (stderr, hPutStrLn) import Control.Monad.IO.Class (liftIO) import Xmobar.System.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 = handle printException exportConnection where printException :: ClientError -> IO () printException = hPutStrLn stderr . clientErrorMessage exportConnection = do client <- connectSession requestName client busName [ nameDoNotQueue ] export client objectPath defaultInterface { DC.interfaceName = interfaceName , DC.interfaceMethods = [ sendSignalMethod mvst ] } sendSignalMethod :: TMVar SignalType -> Method sendSignalMethod mvst = makeMethod sendSignalName (signature_ [variantType $ toVariant (undefined :: SignalType)]) (signature_ []) sendSignalMethodCall where sendSignalName :: MemberName sendSignalName = memberName_ "SendSignal" sendSignalMethodCall :: MethodCall -> DBusR Reply sendSignalMethodCall mc = liftIO $ if methodCallMember mc == sendSignalName then do let signals :: [Maybe SignalType] signals = map fromVariant (methodCallBody mc) mapM_ sendSignal signals if any isNothing signals then return ( ReplyError errorInvalidParameters [] ) else return ( ReplyReturn [] ) else return ( ReplyError errorUnknownMethod [] ) sendSignal :: Maybe SignalType -> IO () sendSignal = maybe (return ()) (atomically . putTMVar mvst) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/System/Environment.hs��������������������������������������������������������0000644�0000000�0000000�00000003033�07346545000�017266� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : XMobar.Environment -- Copyright : (c) William Song -- License : BSD-style (see LICENSE) -- -- Maintainer : Will Song <incertia@incertia.net> -- Stability : stable -- Portability : portable -- -- A function to expand environment variables in strings -- ----------------------------------------------------------------------------- module Xmobar.System.Environment(expandEnv) where import qualified Data.Maybe as M import qualified System.Environment as E expandEnv :: String -> IO String expandEnv "" = return "" expandEnv (c:s) = case c of '$' -> do envVar <- M.fromMaybe "" <$> E.lookupEnv e remainder <- expandEnv s' return $ envVar ++ remainder where (e, s') = getVar s getVar "" = ("", "") getVar ('{':s'') = (takeUntil "}" s'', drop 1 . dropUntil "}" $ s'') getVar s'' = (takeUntil filterstr s'', dropUntil filterstr s'') filterstr = ",./? \t;:\"'~`!@#$%^&*()<>-+=\\|" takeUntil f = takeWhile (not . flip elem f) dropUntil f = dropWhile (not . flip elem f) '\\' -> case s == "" of True -> return "\\" False -> do remainder <- expandEnv $ drop 1 s return $ escString s ++ remainder where escString s' = let (cc:_) = s' in case cc of 't' -> "\t" 'n' -> "\n" '$' -> "$" _ -> [cc] _ -> do remainder <- expandEnv s return $ c : remainder �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/System/Kbd.hsc���������������������������������������������������������������0000644�0000000�0000000�00000026661�07346545000�015641� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE ScopedTypeVariables, ForeignFunctionInterface, MultiParamTypeClasses, DeriveDataTypeable, FlexibleInstances, PatternGuards #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Kbd -- Copyright : (c) Martin Perner -- License : BSD-style (see LICENSE) -- -- Maintainer : Martin Perner <martin@perner.cc> -- Stability : unstable -- Portability : unportable -- -- A keyboard layout indicator for Xmobar -- ----------------------------------------------------------------------------- module Xmobar.System.Kbd where import Control.Monad ((<=<)) import Foreign import Foreign.C.Types import Foreign.C.String import Graphics.X11.Xlib import Graphics.X11.Xlib.Extras (none) #include <X11/XKBlib.h> #include <X11/extensions/XKB.h> #include <X11/extensions/XKBstr.h> -- -- Definition for XkbStaceRec and getKbdLayout taken from -- XMonad.Layout.XKBLayout -- data XkbStateRec = XkbStateRec { group :: CUChar, locked_group :: CUChar, base_group :: CUShort, latched_group :: CUShort, mods :: CUChar, base_mods :: CUChar, latched_mods :: CUChar, locked_mods :: CUChar, compat_state :: CUChar, grab_mods :: CUChar, compat_grab_mods :: CUChar, lookup_mods :: CUChar, compat_lookup_mods :: CUChar, ptr_buttons :: CUShort } instance Storable XkbStateRec where sizeOf _ = (#size XkbStateRec) alignment _ = alignment (undefined :: CUShort) poke _ _ = undefined peek ptr = do r_group <- (#peek XkbStateRec, group) ptr r_locked_group <- (#peek XkbStateRec, locked_group) ptr r_base_group <- (#peek XkbStateRec, base_group) ptr r_latched_group <- (#peek XkbStateRec, latched_group) ptr r_mods <- (#peek XkbStateRec, mods) ptr r_base_mods <- (#peek XkbStateRec, base_mods) ptr r_latched_mods <- (#peek XkbStateRec, latched_mods) ptr r_locked_mods <- (#peek XkbStateRec, locked_mods) ptr r_compat_state <- (#peek XkbStateRec, compat_state) ptr r_grab_mods <- (#peek XkbStateRec, grab_mods) ptr r_compat_grab_mods <- (#peek XkbStateRec, compat_grab_mods) ptr r_lookup_mods <- (#peek XkbStateRec, lookup_mods) ptr r_compat_lookup_mods <- (#peek XkbStateRec, compat_lookup_mods) ptr r_ptr_buttons <- (#peek XkbStateRec, ptr_buttons) ptr return XkbStateRec { group = r_group, locked_group = r_locked_group, base_group = r_base_group, latched_group = r_latched_group, mods = r_mods, base_mods = r_base_mods, latched_mods = r_latched_mods, locked_mods = r_locked_mods, compat_state = r_compat_state, grab_mods = r_grab_mods, compat_grab_mods = r_compat_grab_mods, lookup_mods = r_lookup_mods, compat_lookup_mods = r_compat_lookup_mods, ptr_buttons = r_ptr_buttons } foreign import ccall unsafe "X11/XKBlib.h XkbGetState" xkbGetState :: Display -> CUInt -> Ptr XkbStateRec -> IO CInt getKbdLayout :: Display -> IO Int getKbdLayout d = alloca $ \stRecPtr -> do xkbGetState d 0x100 stRecPtr st <- peek stRecPtr return $ fromIntegral (group st) data XkbKeyNameRec = XkbKeyNameRec { name :: Ptr CChar -- array } -- -- the t_ before alias is just because of name collisions -- data XkbKeyAliasRec = XkbKeyAliasRec { real :: Ptr CChar, -- array t_alias :: Ptr CChar -- array } -- -- the t_ before geometry is just because of name collisions -- data XkbNamesRec = XkbNamesRec { keycodes :: Atom, t_geometry :: Atom, symbols :: Atom, types :: Atom, compat :: Atom, vmods :: [Atom], -- Atom vmods[XkbNumVirtualMods]; indicators :: [Atom], -- Atom indicators[XkbNumIndicators]; groups :: [Atom], -- Atom groups[XkbNumKbdGroups]; keys :: Ptr XkbKeyNameRec, key_aliases :: Ptr CChar, -- dont care XkbKeyAliasRec, radio_groups :: Ptr Atom, phys_symbols :: Atom, num_keys :: CUChar, num_key_aliases :: CUChar, num_rg :: CUShort } -- -- the t_ before map, indicators and compat are just because of name collisions -- data XkbDescRec = XkbDescRec { t_dpy :: Ptr CChar, -- struct _XDisplay* ; don't care flags :: CUShort, device_spec :: CUShort, min_key_code :: KeyCode, max_key_code :: KeyCode, ctrls :: Ptr CChar, -- XkbControlsPtr ; dont' care server :: Ptr CChar, -- XkbServerMapPtr ; dont' care t_map :: Ptr CChar, --XkbClientMapPtr ; dont' care t_indicators :: Ptr CChar, -- XkbIndicatorPtr ; dont' care names :: Ptr XkbNamesRec, -- array t_compat :: Ptr CChar, -- XkbCompatMap ; dont' care geom :: Ptr CChar -- XkbGeometryPtr ; dont' care } instance Storable XkbKeyNameRec where sizeOf _ = (#size XkbKeyNameRec) alignment _ = alignment (undefined :: CUShort) poke _ _ = undefined peek ptr = do r_name <- (#peek XkbKeyNameRec, name) ptr return XkbKeyNameRec { name = r_name } instance Storable XkbKeyAliasRec where sizeOf _ = (#size XkbKeyAliasRec) alignment _ = alignment (undefined :: CUShort) poke _ _ = undefined peek ptr = do r_real <- (#peek XkbKeyAliasRec, real) ptr r_alias <- (#peek XkbKeyAliasRec, alias) ptr return XkbKeyAliasRec { real = r_real, t_alias = r_alias } instance Storable XkbNamesRec where sizeOf _ = (#size XkbNamesRec) alignment _ = alignment (undefined :: CUShort) poke _ _ = undefined peek ptr = do r_keycodes <- (#peek XkbNamesRec, keycodes) ptr r_geometry <- (#peek XkbNamesRec, geometry) ptr r_symbols <- (#peek XkbNamesRec, symbols ) ptr r_types <- (#peek XkbNamesRec, types ) ptr r_compat <- (#peek XkbNamesRec, compat ) ptr r_vmods <- peekArray (#const XkbNumVirtualMods) $ (#ptr XkbNamesRec, vmods ) ptr r_indicators <- peekArray (#const XkbNumIndicators) $ (#ptr XkbNamesRec, indicators ) ptr r_groups <- peekArray (#const XkbNumKbdGroups) $ (#ptr XkbNamesRec, groups ) ptr r_keys <- (#peek XkbNamesRec, keys ) ptr r_key_aliases <- (#peek XkbNamesRec, key_aliases ) ptr r_radio_groups <- (#peek XkbNamesRec, radio_groups ) ptr r_phys_symbols <- (#peek XkbNamesRec, phys_symbols ) ptr r_num_keys <- (#peek XkbNamesRec,num_keys ) ptr r_num_key_aliases <- (#peek XkbNamesRec, num_key_aliases ) ptr r_num_rg <- (#peek XkbNamesRec, num_rg ) ptr return XkbNamesRec { keycodes = r_keycodes, t_geometry = r_geometry, symbols = r_symbols, types = r_types, compat = r_compat, vmods = r_vmods, indicators = r_indicators, groups = r_groups, keys = r_keys, key_aliases = r_key_aliases, radio_groups = r_radio_groups, phys_symbols = r_phys_symbols, num_keys = r_num_keys, num_key_aliases = r_num_key_aliases, num_rg = r_num_rg } instance Storable XkbDescRec where sizeOf _ = (#size XkbDescRec) alignment _ = alignment (undefined :: CUShort) poke _ _ = undefined peek ptr = do r_dpy <- (#peek XkbDescRec, dpy) ptr r_flags <- (#peek XkbDescRec, flags) ptr r_device_spec <- (#peek XkbDescRec, device_spec) ptr r_min_key_code <- (#peek XkbDescRec, min_key_code) ptr r_max_key_code <- (#peek XkbDescRec, max_key_code) ptr r_ctrls <- (#peek XkbDescRec, ctrls) ptr r_server <- (#peek XkbDescRec, server) ptr r_map <- (#peek XkbDescRec, map) ptr r_indicators <- (#peek XkbDescRec, indicators) ptr r_names <- (#peek XkbDescRec, names) ptr r_compat <- (#peek XkbDescRec, compat) ptr r_geom <- (#peek XkbDescRec, geom) ptr return XkbDescRec { t_dpy = r_dpy, flags = r_flags, device_spec = r_device_spec, min_key_code = r_min_key_code, max_key_code = r_max_key_code, ctrls = r_ctrls, server = r_server, t_map = r_map, t_indicators = r_indicators, names = r_names, t_compat = r_compat, geom = r_geom } -- -- C bindings -- foreign import ccall unsafe "X11/XKBlib.h XkbAllocKeyboard" xkbAllocKeyboard :: IO (Ptr XkbDescRec) foreign import ccall unsafe "X11/XKBlib.h XkbGetNames" xkbGetNames :: Display -> CUInt -> (Ptr XkbDescRec) -> IO Status foreign import ccall unsafe "X11/XKBlib.h XGetAtomName" xGetAtomName :: Display -> Atom -> IO CString foreign import ccall unsafe "X11/XKBlib.h XkbFreeNames" xkbFreeNames :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO () foreign import ccall unsafe "X11/XKBlib.h XkbFreeKeyboard" xkbFreeKeyboard :: (Ptr XkbDescRec) -> CUInt -> CInt -> IO () foreign import ccall unsafe "X11/XKBlib.h XkbSelectEventDetails" xkbSelectEventDetails :: Display -> CUInt -> CUInt -> CULong -> CULong -> IO CUInt foreign import ccall unsafe "X11/XKBlib.h XkbSelectEvents" xkbSelectEvents :: Display -> CUInt -> CUInt -> CUInt -> IO CUInt xkbUseCoreKbd :: CUInt xkbUseCoreKbd = #const XkbUseCoreKbd xkbStateNotify :: CUInt xkbStateNotify = #const XkbStateNotify xkbIndicatorStateNotify :: CUInt xkbIndicatorStateNotify = #const XkbIndicatorStateNotify xkbMapNotify :: CUInt xkbMapNotify = #const XkbMapNotify xkbMapNotifyMask :: CUInt xkbMapNotifyMask = #const XkbMapNotifyMask xkbNewKeyboardNotifyMask :: CUInt xkbNewKeyboardNotifyMask = #const XkbNewKeyboardNotifyMask xkbAllStateComponentsMask :: CULong xkbAllStateComponentsMask = #const XkbAllStateComponentsMask xkbGroupStateMask :: CULong xkbGroupStateMask = #const XkbGroupStateMask xkbSymbolsNameMask :: CUInt xkbSymbolsNameMask = #const XkbSymbolsNameMask xkbGroupNamesMask :: CUInt xkbGroupNamesMask = #const XkbGroupNamesMask type KbdOpts = [(String, String)] getLayoutStr :: Display -> IO String getLayoutStr dpy = do kbdDescPtr <- xkbAllocKeyboard status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr str <- getLayoutStr' status dpy kbdDescPtr xkbFreeNames kbdDescPtr xkbSymbolsNameMask 1 xkbFreeKeyboard kbdDescPtr 0 1 return str getLayoutStr' :: Status -> Display -> (Ptr XkbDescRec) -> IO String getLayoutStr' st dpy kbdDescPtr = if st == 0 then -- Success do kbdDesc <- peek kbdDescPtr nameArray <- peek (names kbdDesc) atom <- xGetAtomName dpy (symbols nameArray) str <- peekCString atom return str else -- Behaviour on error do return "Error while requesting layout!" getGrpNames :: Display -> IO [String] getGrpNames dpy = do kbdDescPtr <- xkbAllocKeyboard status <- xkbGetNames dpy xkbGroupNamesMask kbdDescPtr str <- getGrpNames' status dpy kbdDescPtr xkbFreeNames kbdDescPtr xkbGroupNamesMask 1 xkbFreeKeyboard kbdDescPtr 0 1 return str getGrpNames' :: Status -> Display -> (Ptr XkbDescRec) -> IO [String] getGrpNames' st dpy kbdDescPtr = if st == 0 then -- Success do kbdDesc <- peek kbdDescPtr nameArray <- peek (names kbdDesc) let grpsArr = groups nameArray let grps = takeWhile (/=none) grpsArr mapM (peekCString <=< xGetAtomName dpy) grps else return ["Error while requesting layout!"] �������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/System/Localize.hsc����������������������������������������������������������0000644�0000000�0000000�00000004612�07346545000�016673� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : Localize -- Copyright : (C) 2011, 2018 Martin Perner -- License : BSD-style (see LICENSE) -- -- Maintainer : Martin Perner <martin@perner.cc> -- Stability : unstable -- Portability : unportable -- -- This module provides an interface to locale information e.g. for DateL -- ----------------------------------------------------------------------------- module Xmobar.System.Localize ( setupTimeLocale, getTimeLocale ) where import Foreign.C #if ! MIN_VERSION_time(1,5,0) import qualified System.Locale as L #else import qualified Data.Time.Format as L #endif import Codec.Binary.UTF8.String -- get localized strings type NlItem = CInt #include <langinfo.h> foreign import ccall unsafe "langinfo.h nl_langinfo" nl_langinfo :: NlItem -> IO CString #{enum NlItem, , AM_STR , PM_STR \ , D_T_FMT , D_FMT , T_FMT , T_FMT_AMPM \ , ABDAY_1, ABDAY_7 \ , DAY_1, DAY_7 \ , ABMON_1, ABMON_12 \ , MON_1, MON_12\ } getLangInfo :: NlItem -> IO String getLangInfo item = do itemStr <- nl_langinfo item str <- peekCString itemStr return $ if isUTF8Encoded str then decodeString str else str #include <locale.h> foreign import ccall unsafe "locale.h setlocale" setlocale :: CInt -> CString -> IO CString setupTimeLocale :: String -> IO () setupTimeLocale l = withCString l (setlocale #const LC_TIME) >> return () getTimeLocale :: IO L.TimeLocale getTimeLocale = do -- assumes that the defined values are increasing by exactly one. -- as they are defined consecutive in an enum this is reasonable days <- mapM getLangInfo [day1 .. day7] abdays <- mapM getLangInfo [abday1 .. abday7] mons <- mapM getLangInfo [mon1 .. mon12] abmons <- mapM getLangInfo [abmon1 .. abmon12] amstr <- getLangInfo amStr pmstr <- getLangInfo pmStr dtfmt <- getLangInfo dTFmt dfmt <- getLangInfo dFmt tfmt <- getLangInfo tFmt tfmta <- getLangInfo tFmtAmpm let t = L.defaultTimeLocale {L.wDays = zip days abdays ,L.months = zip mons abmons ,L.amPm = (amstr, pmstr) ,L.dateTimeFmt = dtfmt ,L.dateFmt = dfmt ,L.timeFmt = tfmt ,L.time12Fmt = tfmta} return t ����������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/System/Signal.hs�������������������������������������������������������������0000644�0000000�0000000�00000007266�07346545000�016213� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# 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 Xmobar.System.Signal where import Data.Foldable (for_) import Data.Typeable (Typeable) import Control.Concurrent import Control.Concurrent.STM import Control.Exception import System.Posix.Signals import Graphics.X11.Types (Button) import Graphics.X11.Xlib.Types (Position) import System.IO #ifdef DBUS import DBus (IsVariant(..)) import Control.Monad ((>=>)) #endif safeHead :: [a] -> Maybe a safeHead [] = Nothing safeHead (x:_) = Just x data WakeUp = WakeUp deriving (Show,Typeable) instance Exception WakeUp data SignalType = Wakeup | Reposition | ChangeScreen | Hide Int | Reveal Int | Toggle Int | SetAlpha Int | TogglePersistent | Action Button Position 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 :: TMVar SignalType -> IO () setupSignalHandler tid = do installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing return () updatePosHandler :: TMVar SignalType -> IO () updatePosHandler sig = do atomically $ putTMVar sig Reposition return () changeScreenHandler :: TMVar SignalType -> IO () changeScreenHandler sig = do atomically $ putTMVar sig ChangeScreen return () -- | Ensures that the given IO action runs its cleanup actions ('bracket' etc.), -- even if a signal is caught. -- -- An exception will be thrown on the thread that called this function when a -- signal is caught. withDeferSignals :: IO a -> IO a withDeferSignals thing = do threadId <- myThreadId caughtSignal <- newEmptyMVar let signals = filter (not . flip inSignalSet reservedSignals) [ sigQUIT , sigTERM --, sigINT -- Handler already installed by GHC --, sigPIPE -- Handler already installed by GHC --, sigUSR1 -- Handled by setupSignalHandler --, sigUSR2 -- Handled by setupSignalHandler -- One of the following appears to cause instability, see #360 --, sigHUP --, sigILL --, sigABRT --, sigFPE --, sigSEGV --, sigALRM --, sigBUS --, sigPOLL --, sigPROF --, sigSYS --, sigTRAP --, sigVTALRM --, sigXCPU --, sigXFSZ ] for_ signals $ \s -> installHandler s (Catch $ do tryPutMVar caughtSignal s hPutStrLn stderr ("xmobar: Caught signal "++show s++"; exiting...") throwTo threadId ThreadKilled) Nothing thing `finally` do s0 <- tryReadMVar caughtSignal case s0 of Nothing -> pure () Just s -> do -- Run the default handler for the signal -- hPutStrLn stderr ("xmobar: Running default handler for signal "++show s) installHandler s Default Nothing raiseSignal s ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/System/StatFS.hsc������������������������������������������������������������0000644�0000000�0000000�00000004771�07346545000�016303� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : StatFS -- Copyright : (c) Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> -- Stability : unstable -- Portability : unportable -- -- A binding to C's statvfs(2) -- ----------------------------------------------------------------------------- {-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} module Xmobar.System.StatFS ( FileSystemStats(..), getFileSystemStats ) where import Foreign import Foreign.C.Types import Foreign.C.String import Data.ByteString (useAsCString) import Data.ByteString.Char8 (pack) #if defined (__FreeBSD__) || defined (__OpenBSD__) || defined (__APPLE__) || defined (__DragonFly__) #define IS_BSD_SYSTEM #endif #ifdef IS_BSD_SYSTEM # include <sys/param.h> # include <sys/mount.h> #else # include <sys/vfs.h> #endif data FileSystemStats = FileSystemStats { fsStatBlockSize :: Integer -- ^ Optimal transfer block size. , fsStatBlockCount :: Integer -- ^ Total data blocks in file system. , fsStatByteCount :: Integer -- ^ Total bytes in file system. , fsStatBytesFree :: Integer -- ^ Free bytes in file system. , fsStatBytesAvailable :: Integer -- ^ Free bytes available to non-superusers. , fsStatBytesUsed :: Integer -- ^ Bytes used. } deriving (Show, Eq) data CStatfs #ifdef IS_BSD_SYSTEM foreign import ccall unsafe "sys/mount.h statfs" #else foreign import ccall unsafe "sys/vfs.h statvfs" #endif c_statfs :: CString -> Ptr CStatfs -> IO CInt toI :: CULong -> Integer toI = toInteger getFileSystemStats :: String -> IO (Maybe FileSystemStats) getFileSystemStats path = allocaBytes (#size struct statfs) $ \vfs -> useAsCString (pack path) $ \cpath -> do res <- c_statfs cpath vfs if res /= 0 then return Nothing else do bsize <- (#peek struct statfs, f_bsize) vfs bcount <- (#peek struct statfs, f_blocks) vfs bfree <- (#peek struct statfs, f_bfree) vfs bavail <- (#peek struct statfs, f_bavail) vfs let bpb = toI bsize return $ Just FileSystemStats { fsStatBlockSize = bpb , fsStatBlockCount = toI bcount , fsStatByteCount = toI bcount * bpb , fsStatBytesFree = toI bfree * bpb , fsStatBytesAvailable = toI bavail * bpb , fsStatBytesUsed = toI (bcount - bfree) * bpb } �������xmobar-0.46/src/Xmobar/System/Utils.hs��������������������������������������������������������������0000644�0000000�0000000�00000003637�07346545000�016074� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | -- Module: Utils -- Copyright: (c) 2010, 2018, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: Jose A Ortega Ruiz <jao@gnu.org> -- Stability: unstable -- Portability: unportable -- Created: Sat Dec 11, 2010 20:55 -- -- -- Miscellaneous utility functions -- ------------------------------------------------------------------------------ module Xmobar.System.Utils ( expandHome , changeLoop , safeIndex , forkThread ) where import Control.Monad import Control.Concurrent.STM import Control.Exception (handle, SomeException(..)) #ifdef THREADED_RUNTIME import Control.Concurrent (forkOS) #else import Control.Concurrent (forkIO) #endif import qualified Data.List.NonEmpty as NE import Data.Maybe (fromMaybe) import System.Environment import System.FilePath expandHome :: FilePath -> IO FilePath expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME") expandHome p = return p forkThread :: String -> IO () -> IO () forkThread name action = do #ifdef THREADED_RUNTIME _ <- forkOS (handle (onError name) action) #else _ <- forkIO (handle (onError name) action) #endif return () where onError thing (SomeException e) = void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e) changeLoop :: Eq a => STM a -> (a -> IO ()) -> IO () changeLoop s f = atomically s >>= go where go old = do f old go =<< atomically (do new <- s guard (new /= old) return new) (!!?) :: [a] -> Int -> Maybe a (!!?) xs i | i < 0 = Nothing | otherwise = go i xs where go :: Int -> [a] -> Maybe a go 0 (x:_) = Just x go j (_:ys) = go (j - 1) ys go _ [] = Nothing {-# INLINE (!!?) #-} safeIndex :: NE.NonEmpty a -> Int -> a safeIndex xs index = fromMaybe (NE.head xs) (NE.toList xs !!? index) �������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Text/������������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�014067� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Text/Ansi.hs�����������������������������������������������������������������0000644�0000000�0000000�00000003134�07346545000�015316� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Text.Ansi -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Fri Feb 4, 2022 01:10 -- -- -- Codification with ANSI (color) escape codes -- ------------------------------------------------------------------------------ module Xmobar.Text.Ansi (withAnsiColor) where import Data.List (intercalate) import Data.Char (toLower) asInt :: String -> String asInt x = case (reads $ "0x" ++ x) :: [(Integer, String)] of [(v, "") ] -> show v _ -> "" namedColor :: String -> String namedColor c = case map toLower c of "black" -> "0"; "red" -> "1"; "green" -> "2"; "yellow" -> "3"; "blue" -> "4"; "magenta" -> "5"; "cyan" -> "6"; "white" -> "7"; "brightblack" -> "8"; "brightred" -> "9"; "brightgreen" -> "10"; "brightyellow" -> "11"; "brightblue" -> "12"; "brightmagenta" -> "13"; "brightcyan" -> "14"; "brightwhite" -> "15"; _ -> "" ansiCode :: String -> String ansiCode ('#':r:g:[b]) = ansiCode ['#', '0', r, '0', g, '0', b] ansiCode ('#':r0:r1:g0:g1:b0:[b1]) = "2;" ++ intercalate ";" (map asInt [[r0,r1], [g0,g1], [b0,b1]]) ansiCode ('#':n) = ansiCode n ansiCode c = "5;" ++ if null i then namedColor c else i where i = asInt c withAnsiColor :: (String, String) -> String -> String withAnsiColor (fg, bg) s = wrap "38;" fg (wrap "48;" bg s) where wrap cd cl w = if null cl then w else "\x1b[" ++ cd ++ ansiCode cl ++ "m" ++ w ++ "\x1b[0m" ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Text/Loop.hs�����������������������������������������������������������������0000644�0000000�0000000�00000002610�07346545000�015333� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Text.Loop -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: unportable -- Created: Fri Jan 28, 2022 01:21 -- -- -- Text-only event loop -- ------------------------------------------------------------------------------ module Xmobar.Text.Loop (textLoop) where import Prelude hiding (lookup) import System.IO (hSetBuffering, stdin, stdout, BufferMode(LineBuffering)) import Control.Concurrent.STM import Xmobar.System.Signal import Xmobar.Config.Types (Config) import Xmobar.Run.Loop (loop) import Xmobar.Text.Output (initLoop, format) -- | Starts the main event loop and threads textLoop :: Config -> IO () textLoop conf = do hSetBuffering stdin LineBuffering hSetBuffering stdout LineBuffering initLoop conf loop conf (eventLoop conf) -- | Continuously wait for a signal from a thread or a interrupt handler eventLoop :: Config -> TMVar SignalType -> TVar [String] -> IO () eventLoop cfg signal tv = do typ <- atomically $ takeTMVar signal case typ of Wakeup -> updateString cfg tv >>= putStrLn >> eventLoop cfg signal tv _ -> eventLoop cfg signal tv updateString :: Config -> TVar [String] -> IO String updateString conf v = do s <- readTVarIO v return $ format conf (concat s) ������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Text/Output.hs���������������������������������������������������������������0000644�0000000�0000000�00000003350�07346545000�015724� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������-- | -- Module: Xmobar.Text.Output -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Fri Feb 4, 2022 01:10 -- -- -- Format strings emitted by Commands into output strings -- ------------------------------------------------------------------------------ module Xmobar.Text.Output (initLoop, format) where import Xmobar.Config.Types ( Config (..) , TextOutputFormat (..) , Segment , Widget (..) , tColorsString) import Xmobar.Config.Parse (colorComponents) import Xmobar.Config.Template (parseString) import Xmobar.Text.Ansi (withAnsiColor) import Xmobar.Text.Pango (withPangoMarkup) import Xmobar.Text.Swaybar (formatSwaybar, prepare) initLoop :: Config -> IO () initLoop conf = case textOutputFormat conf of Swaybar -> prepare _ -> return () formatWithColor :: Config -> Segment -> String formatWithColor conf (Text s, info, idx, _) = case textOutputFormat conf of Ansi -> withAnsiColor (fg, bg) s Pango -> withPangoMarkup fg bg fn s _ -> s where (fg, bg) = colorComponents conf (tColorsString info) fonts = additionalFonts conf fn = if idx < 1 || idx > length fonts then font conf else fonts !! (idx - 1) formatWithColor conf (Hspace n, i, x, y) = formatWithColor conf (Text $ replicate (fromIntegral n) ' ', i, x, y) formatWithColor _ _ = "" format :: Config -> String -> String format conf s = do let segments = parseString conf s case textOutputFormat conf of Swaybar -> formatSwaybar conf segments _ -> concatMap (formatWithColor conf) segments ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Text/Pango.hs����������������������������������������������������������������0000644�0000000�0000000�00000003216�07346545000�015471� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Text.Pango -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Author: Pavel Kalugin -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Fri Feb 4, 2022 01:15 -- -- -- Codification with Pango markup -- ------------------------------------------------------------------------------ module Xmobar.Text.Pango (withPangoColor, withPangoFont, withPangoMarkup, fixXft) where import Text.Printf (printf) import Data.List (isPrefixOf) replaceAll :: (Eq a) => a -> [a] -> [a] -> [a] replaceAll c s = concatMap (\x -> if x == c then s else [x]) xmlEscape :: String -> String xmlEscape s = replaceAll '"' """ $ replaceAll '\'' "'" $ replaceAll '<' "<" $ replaceAll '>' ">" $ replaceAll '&' "&" s withPangoColor :: (String, String) -> String -> String withPangoColor (fg, bg) s = printf fmt (xmlEscape fg) (xmlEscape bg) (xmlEscape s) where fmt = "<span foreground=\"%s\" background=\"%s\">%s</span>" fixXft :: String -> String fixXft font = if "xft:" `isPrefixOf` font then replaceAll '-' " " $ drop 4 font else font withPangoFont :: String -> String -> String withPangoFont font txt = printf fmt (fixXft font) (xmlEscape txt) where fmt = "<span font=\"%s\">%s</span>" withPangoMarkup :: String -> String -> String -> String -> String withPangoMarkup fg bg font txt = printf fmt (fixXft font) (xmlEscape fg) (xmlEscape bg) (xmlEscape txt) where fmt = "<span font=\"%s\" foreground=\"%s\" background=\"%s\">%s</span>" ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Text/Swaybar.hs��������������������������������������������������������������0000644�0000000�0000000�00000011354�07346545000�016037� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE DeriveGeneric #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Text.Swaybar -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Fri Feb 4, 2022 03:58 -- -- -- Segment codification using swaybar-protocol JSON strings -- ------------------------------------------------------------------------------ module Xmobar.Text.Swaybar (prepare, formatSwaybar) where import Data.Aeson import Data.ByteString.Lazy.UTF8 (toString) import GHC.Generics import Xmobar.Config.Types ( Config (additionalFonts) , Segment , Widget(..) , Box(..) , BoxBorder(..) , FontIndex , tBoxes , tColorsString) import Xmobar.Config.Parse (colorComponents) import Xmobar.Text.SwaybarClicks (startHandler) import Xmobar.Text.Pango (withPangoFont) data Preamble = Preamble {version :: !Int, click_events :: Bool} deriving (Eq,Show,Generic) asString :: ToJSON a => a -> String asString = toString . encode preamble :: String preamble = (asString $ Preamble { version = 1, click_events = True }) ++ "\x0A[" data Block = Block { full_text :: !String , name :: !String , color :: Maybe String , background :: Maybe String , separator :: !Bool , separator_block_width :: !Int , border :: Maybe String , border_top :: Maybe Int , border_bottom :: Maybe Int , border_left :: Maybe Int , border_right :: Maybe Int , markup :: Maybe String } deriving (Eq,Show,Generic) defaultBlock :: Block defaultBlock = Block { full_text = "" , name = "" , color = Nothing , background = Nothing , separator = False , separator_block_width = 0 , border = Nothing , border_top = Nothing , border_bottom = Nothing , border_left = Nothing , border_right = Nothing , markup = Nothing } instance ToJSON Block where toJSON = genericToJSON defaultOptions { omitNothingFields = True } instance ToJSON Preamble withBox :: Box -> Block -> Block withBox (Box b _ n c _) block = (case b of BBFull -> bl { border_right = w, border_left = w , border_bottom = w, border_top = w } BBTop -> bl { border_top = w } BBBottom -> bl { border_bottom = w } BBVBoth -> bl { border_bottom = w, border_top = w } BBLeft -> bl { border_left = w } BBRight -> bl { border_right = w } BBHBoth -> bl { border_right = w, border_left = w } ) { border = bc } where w = Just (fromIntegral n) bc = if null c then Nothing else Just c j0 = Just 0 bl = block { border_right = j0, border_left = j0 , border_bottom = j0, border_top = j0 } withFont :: Config -> FontIndex -> Block -> Block withFont conf idx block = if idx < 1 || idx > length fonts then block else block { markup = Just $ fonts !! (idx - 1) } where fonts = additionalFonts conf withPango :: Block -> Block withPango block = case markup block of Nothing -> block Just fnt -> block { full_text = txt fnt, markup = Just "pango"} where txt fn = withPangoFont fn (full_text block) formatSwaybar' :: Config -> Segment -> Block formatSwaybar' conf (Text txt, info, idx, as) = foldr withBox (withFont conf idx block) (tBoxes info) where (fg, bg) = colorComponents conf (tColorsString info) block = defaultBlock { full_text = txt , color = Just fg , background = Just bg , name = show as } formatSwaybar' conf (Hspace n, info, i, a) = formatSwaybar' conf (Text (replicate (fromIntegral n) ' '), info, i, a) formatSwaybar' _ _ = defaultBlock collectBlock :: Block -> [Block] -> [Block] collectBlock b [] = [b] collectBlock b (h:bs) = if b {full_text = ""} == h {full_text = ""} then h {full_text = full_text b ++ full_text h} : bs else b:h:bs collectSegment :: Config -> Segment -> [Block] -> [Block] collectSegment config segment blocks = if null $ full_text b then blocks else collectBlock b blocks where b = formatSwaybar' config segment formatSwaybar :: Config -> [Segment] -> String formatSwaybar conf segs = asString (map withPango blocks) ++ "," where blocks = foldr (collectSegment conf) [] segs prepare :: IO () prepare = startHandler >> putStrLn preamble ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/Text/SwaybarClicks.hs��������������������������������������������������������0000644�0000000�0000000�00000002704�07346545000�017167� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE DeriveGeneric #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Text.SwaybarClicks -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Fri Feb 4, 2022 03:58 -- -- -- Handling of "click" events sent by swaybar via stdin -- ------------------------------------------------------------------------------ module Xmobar.Text.SwaybarClicks (startHandler) where import Control.Monad (when) import Data.Aeson import GHC.Generics import Xmobar.System.Utils (forkThread) import Xmobar.Run.Actions (Action (..), runAction') import Data.ByteString.Lazy.UTF8 (fromString) data Click = Click { name :: String , button :: Int } deriving (Eq,Show,Generic) instance FromJSON Click runClickAction :: Int -> Action -> IO () runClickAction b a@(Spawn bs _) = when (fromIntegral b `elem` bs) (runAction' a) handleClick :: Maybe Click -> IO () handleClick Nothing = return () handleClick (Just click) = do let mas = read (name click) :: Maybe [Action] b = button click maybe (return ()) (mapM_ (runClickAction b)) mas toClick :: String -> Maybe Click toClick (',':s) = toClick s toClick s = decode (fromString s) readClicks :: IO () readClicks = getLine >>= handleClick . toClick >> readClicks startHandler :: IO () startHandler = forkThread "Swaybar event handler" readClicks ������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/�������������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�013514� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/Bitmap.hs����������������������������������������������������������������0000644�0000000�0000000�00000007524�07346545000�015274� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP, FlexibleContexts #-} ----------------------------------------------------------------------------- -- | -- Module : X11.Bitmap -- Copyright : (C) 2013, 2015, 2017, 2018, 2022 Alexander Polakov -- License : BSD3 -- -- Maintainer : jao@gnu.org -- Stability : unstable -- Portability : unportable -- ----------------------------------------------------------------------------- module Xmobar.X11.Bitmap ( updateCache , drawBitmap , Bitmap(..) , BitmapCache) where import Control.Monad import Control.Monad.Trans(MonadIO(..)) import Data.Map hiding (map) import Graphics.X11.Xlib hiding (Segment) import System.Directory (doesFileExist) import System.FilePath ((</>)) import System.Mem.Weak ( addFinalizer ) import Xmobar.X11.ColorCache #ifdef XPM import Xmobar.X11.XPMFile(readXPMFile) import Control.Applicative((<|>)) #endif #if MIN_VERSION_mtl(2, 2, 1) import Control.Monad.Except(MonadError(..), runExceptT) #else import Control.Monad.Error(MonadError(..)) import Control.Monad.Trans.Error(ErrorT, runErrorT) runExceptT :: ErrorT e m a -> m (Either e a) runExceptT = runErrorT #endif data BitmapType = Mono Pixel | Poly data Bitmap = Bitmap { width :: Dimension , height :: Dimension , pixmap :: Pixmap , shapePixmap :: Maybe Pixmap , bitmapType :: BitmapType } type BitmapCache = Map FilePath Bitmap updateCache :: Display -> Window -> BitmapCache -> FilePath -> [FilePath] -> IO BitmapCache updateCache dpy win cache iconRoot paths = do let expandPath path@('/':_) = path expandPath path@('.':'/':_) = path expandPath path@('.':'.':'/':_) = path expandPath path = iconRoot </> path go m path = if member path m then return m else do bitmap <- loadBitmap dpy win $ expandPath path return $ maybe m (\b -> insert path b m) bitmap foldM go cache paths readBitmapFile' :: (MonadError String m, MonadIO m) => Display -> Drawable -> String -> m (Dimension, Dimension, Pixmap) readBitmapFile' d w p = do res <- liftIO $ readBitmapFile d w p case res of Left err -> throwError err Right (bw, bh, bp, _, _) -> return (bw, bh, bp) loadBitmap :: Display -> Drawable -> FilePath -> IO (Maybe Bitmap) loadBitmap d w p = do exist <- doesFileExist p if exist then do #ifdef XPM res <- runExceptT (tryXBM <|> tryXPM) #else res <- runExceptT tryXBM #endif case res of Right b -> return $ Just b Left err -> do putStrLn err return Nothing else return Nothing where tryXBM = do (bw, bh, bp) <- readBitmapFile' d w p liftIO $ addFinalizer bp (freePixmap d bp) return $ Bitmap bw bh bp Nothing (Mono 1) #ifdef XPM tryXPM = do (bw, bh, bp, mbpm) <- readXPMFile d w p liftIO $ addFinalizer bp (freePixmap d bp) case mbpm of Nothing -> return () Just bpm -> liftIO $ addFinalizer bpm (freePixmap d bpm) return $ Bitmap bw bh bp mbpm Poly #endif drawBitmap :: Display -> Drawable -> GC -> String -> String -> Position -> Position -> Bitmap -> IO () drawBitmap d p gc fc bc x y i = withColors d [fc, bc] $ \[fc', bc'] -> do let w = width i h = height i y' = 1 + y - fromIntegral h `div` 2 setForeground d gc fc' setBackground d gc bc' case shapePixmap i of Nothing -> return () Just mask -> setClipOrigin d gc x y' >> setClipMask d gc mask case bitmapType i of Poly -> copyArea d (pixmap i) p gc 0 0 w h x y' Mono pl -> copyPlane d (pixmap i) p gc 0 0 w h x y' pl setClipMask d gc 0 ����������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/CairoSurface.hsc���������������������������������������������������������0000644�0000000�0000000�00000004475�07346545000�016573� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Cairo -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: unportable -- Created: Thu Sep 08, 2022 01:25 -- -- -- Xlib Cairo Surface creation -- ------------------------------------------------------------------------------ module Xmobar.X11.CairoSurface (withXlibSurface , withBitmapSurface , setSurfaceDrawable) where import Graphics.X11.Xlib.Types import Graphics.X11.Types import Graphics.X11.Xlib (defaultScreenOfDisplay) import Graphics.Rendering.Cairo.Types import qualified Graphics.Rendering.Cairo.Internal as Internal import Foreign import Foreign.C #include <cairo/cairo-xlib.h> foreign import ccall "cairo_xlib_surface_create" cSurfaceCreate :: Display -> Drawable -> Visual -> CInt -> CInt -> Ptr Surface foreign import ccall "cairo_xlib_surface_create_for_bitmap" cBitmapCreate :: Display -> Pixmap -> Screen -> CInt -> CInt -> Ptr Surface foreign import ccall "cairo_xlib_surface_set_drawable" cSetDrawable :: Ptr Surface -> Drawable -> CInt -> CInt -> () createXlibSurface :: Display -> Drawable -> Visual -> Int -> Int -> IO Surface createXlibSurface d dr v w h = mkSurface $ cSurfaceCreate d dr v (fromIntegral w) (fromIntegral h) withXlibSurface :: Display -> Drawable -> Visual -> Int -> Int -> (Surface -> IO a) -> IO a withXlibSurface d dr v w h f = do surface <- createXlibSurface d dr v w h ret <- f surface Internal.surfaceDestroy surface return ret createBitmapSurface :: Display -> Pixmap -> Screen -> Int -> Int -> IO Surface createBitmapSurface d p s w h = mkSurface $ cBitmapCreate d p s (fromIntegral w) (fromIntegral h) withBitmapSurface :: Display -> Pixmap -> Int -> Int -> (Surface -> IO a) -> IO a withBitmapSurface d p w h f = do surface <- createBitmapSurface d p (defaultScreenOfDisplay d) w h ret <- f surface Internal.surfaceDestroy surface return ret setSurfaceDrawable :: Surface -> Drawable -> Int -> Int -> IO () setSurfaceDrawable surface dr w h = withSurface surface $ \s -> return $ cSetDrawable s dr (fromIntegral w) (fromIntegral h) ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/ColorCache.hs������������������������������������������������������������0000644�0000000�0000000�00000003674�07346545000�016064� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | -- Module: ColorCache -- Copyright: (c) 2012, 2022 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 -- ------------------------------------------------------------------------------ module Xmobar.X11.ColorCache(withColors) where import qualified Data.IORef as IO import qualified System.IO.Unsafe as U import qualified Control.Exception as E import qualified Control.Monad.Trans as Tr import qualified Graphics.X11.Xlib as X data DynPixel = DynPixel Bool X.Pixel initColor :: X.Display -> String -> IO DynPixel initColor dpy c = E.handle black $ initColor' dpy c where black :: E.SomeException -> IO DynPixel black = const . return $ DynPixel False (X.blackPixel dpy $ X.defaultScreen dpy) type ColorCache = [(String, X.Color)] {-# NOINLINE colorCache #-} colorCache :: IO.IORef ColorCache colorCache = U.unsafePerformIO $ IO.newIORef [] getCachedColor :: String -> IO (Maybe X.Color) getCachedColor color_name = lookup color_name `fmap` IO.readIORef colorCache putCachedColor :: String -> X.Color -> IO () putCachedColor name c_id = IO.modifyIORef colorCache $ \c -> (name, c_id) : c initColor' :: X.Display -> String -> IO DynPixel initColor' dpy c = do let colormap = X.defaultColormap dpy (X.defaultScreen dpy) cached_color <- getCachedColor c c' <- case cached_color of Just col -> return col _ -> do (c'', _) <- X.allocNamedColor dpy colormap c putCachedColor c c'' return c'' return $ DynPixel True (X.color_pixel c') withColors :: Tr.MonadIO m => X.Display -> [String] -> ([X.Pixel] -> m a) -> m a withColors d cs f = do ps <- mapM (Tr.liftIO . initColor d) cs f $ map (\(DynPixel _ pixel) -> pixel) ps ��������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/Draw.hs������������������������������������������������������������������0000644�0000000�0000000�00000005610�07346545000�014747� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Draw -- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: unportable -- Created: Fri Sep 09, 2022 02:03 -- -- Drawing the xmobar contents using Cairo and Pango -- -- ------------------------------------------------------------------------------ module Xmobar.X11.Draw (draw) where import qualified Data.Map as M import Control.Monad.IO.Class (liftIO) import Control.Monad.Reader (ask) import Foreign.C.Types as FT import qualified Graphics.X11.Xlib as X11 import qualified Xmobar.Config.Types as C import qualified Xmobar.Draw.Types as D import qualified Xmobar.Draw.Cairo as DC import qualified Xmobar.X11.Bitmap as B import qualified Xmobar.X11.Types as T import qualified Xmobar.X11.CairoSurface as CS #ifdef XRENDER import qualified Xmobar.X11.XRender as XRender #endif drawXBitmap :: T.XConf -> X11.GC -> X11.Pixmap -> D.IconDrawer drawXBitmap xconf gc p h v path fc bc = do let disp = T.display xconf case M.lookup path (T.iconCache xconf) of Just bm -> liftIO $ B.drawBitmap disp p gc fc bc (round h) (round v) bm Nothing -> return () lookupXBitmap :: T.XConf -> String -> (Double, Double) lookupXBitmap xconf path = case M.lookup path (T.iconCache xconf) of Just bm -> (fromIntegral (B.width bm), fromIntegral (B.height bm)) Nothing -> (0, 0) withPixmap :: X11.Display -> X11.Drawable -> X11.Rectangle -> FT.CInt -> (X11.GC -> X11.Pixmap -> IO a) -> IO a withPixmap disp win (X11.Rectangle _ _ w h) depth action = do p <- X11.createPixmap disp win w h depth gc <- X11.createGC disp win X11.setGraphicsExposures disp gc False res <- action gc p -- copy the pixmap with the new string to the window X11.copyArea disp p win gc 0 0 w h 0 0 -- free up everything (we do not want to leak memory!) X11.freeGC disp gc X11.freePixmap disp p -- resync (discard events, we don't read/process events from this display conn) X11.sync disp True return res draw :: [[C.Segment]] -> T.X [D.ActionPos] draw segments = do xconf <- ask let disp = T.display xconf win = T.window xconf rect@(X11.Rectangle _ _ w h) = T.rect xconf screen = X11.defaultScreenOfDisplay disp depth = X11.defaultDepthOfScreen screen vis = X11.defaultVisualOfScreen screen conf = T.config xconf liftIO $ withPixmap disp win rect depth $ \gc p -> do let bdraw = drawXBitmap xconf gc p blook = lookupXBitmap xconf dctx = D.DC bdraw blook conf (fromIntegral w) (fromIntegral h) segments render = DC.drawSegments dctx #ifdef XRENDER color = C.bgColor conf alph = C.alpha conf XRender.drawBackground disp p color alph rect #endif CS.withXlibSurface disp p vis (fromIntegral w) (fromIntegral h) render ������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/Events.hs����������������������������������������������������������������0000644�0000000�0000000�00000001641�07346545000�015316� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Events -- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sun Nov 25, 2018 23:24 -- -- -- Utilities or event handling -- ------------------------------------------------------------------------------ module Xmobar.X11.Events(nextEvent') where import qualified Control.Concurrent as C import qualified System.Posix.Types as T import qualified Graphics.X11.Xlib as X -- | A version of nextEvent that does not block in foreign calls. nextEvent' :: X.Display -> X.XEventPtr -> IO () nextEvent' d p = do pend <- X.pending d if pend /= 0 then X.nextEvent d p else do C.threadWaitRead (T.Fd fd) nextEvent' d p where fd = X.connectionNumber d �����������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/Loop.hs������������������������������������������������������������������0000644�0000000�0000000�00000014223�07346545000�014763� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.X11EventLoop -- Copyright: (c) 2018, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sat Nov 24, 2018 19:40 -- -- -- Event loop -- ------------------------------------------------------------------------------ module Xmobar.X11.Loop (x11Loop) where import Prelude hiding (lookup) import Control.Concurrent as Concurrent import Control.Concurrent.STM as STM import Control.Monad.Reader as MR import Data.Bits (Bits((.|.))) import Data.List.NonEmpty (NonEmpty((:|))) import qualified Data.List.NonEmpty as NE import qualified Data.Map as Map import qualified Graphics.X11.Xlib as X11 import qualified Graphics.X11.Xlib.Extras as X11x import qualified Graphics.X11.Xinerama as Xinerama import qualified Graphics.X11.Xrandr as Xrandr import qualified Xmobar.Config.Types as C import qualified Xmobar.Config.Template as CT import qualified Xmobar.Run.Actions as A import qualified Xmobar.Run.Loop as L import qualified Xmobar.System.Utils as U import qualified Xmobar.System.Signal as S import qualified Xmobar.Draw.Types as D import qualified Xmobar.X11.Types as T import qualified Xmobar.X11.Text as Text import qualified Xmobar.X11.Draw as Draw import qualified Xmobar.X11.Bitmap as Bitmap import qualified Xmobar.X11.Window as W #ifndef THREADED_RUNTIME import qualified Xmobar.X11.Events as E #endif runX :: T.XConf -> T.X a -> IO a runX xc f = MR.runReaderT f xc -- | Starts the main event loop thread x11Loop :: C.Config -> IO () x11Loop conf = do X11.initThreads d <- X11.openDisplay "" fs <- Text.initFont d (C.font conf) fl <- mapM (Text.initFont d) (C.additionalFonts conf) (r,w) <- W.createWin d fs conf L.loop conf (startLoop (T.XConf d r w (fs :| fl) Map.empty conf)) startLoop :: T.XConf -> STM.TMVar S.SignalType -> STM.TVar [String] -> IO () startLoop xcfg sig tv = do U.forkThread "X event handler" (eventLoop (T.display xcfg) (T.window xcfg) sig) signalLoop xcfg [] sig tv -- | Translates X11 events received by w to signals handled by signalLoop eventLoop :: X11.Display -> X11.Window -> STM.TMVar S.SignalType -> IO () eventLoop dpy w signalv = X11.allocaXEvent $ \e -> do let root = X11.defaultRootWindow dpy m = X11.exposureMask .|. X11.structureNotifyMask .|. X11.buttonPressMask Xrandr.xrrSelectInput dpy root X11.rrScreenChangeNotifyMask X11.selectInput dpy w m MR.forever $ do #ifdef THREADED_RUNTIME X11.nextEvent dpy e #else E.nextEvent' dpy e #endif ev <- X11x.getEvent e let send = STM.atomically . STM.putTMVar signalv case ev of X11x.ConfigureEvent {} -> send S.Reposition X11x.RRScreenChangeNotifyEvent {} -> send S.Reposition X11x.ExposeEvent {} -> send S.Wakeup X11x.ButtonEvent {} -> send (S.Action b p) where (b, p) = (X11x.ev_button ev, fromIntegral $ X11x.ev_x ev) _ -> return () -- | Continuously wait for a signal from a thread or an interrupt handler. -- The list of actions provides the positions of clickable rectangles, -- and there is a mutable variable for received signals and the list -- of strings updated by running monitors. signalLoop :: T.XConf -> D.Actions -> STM.TMVar S.SignalType -> STM.TVar [String] -> IO () signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do typ <- STM.atomically $ STM.takeTMVar signalv case typ of S.Wakeup -> wakeup S.Action button x -> runActions actions button x >> loopOn S.Reposition -> reposWindow cfg S.ChangeScreen -> updateConfigPosition d cfg >>= reposWindow S.Hide t -> hiderev t S.Hide W.hideWindow S.Reveal t -> hiderev t S.Reveal (W.showWindow r cfg) S.Toggle t -> toggle t S.TogglePersistent -> updateCfg $ cfg {C.persistent = not $ C.persistent cfg} S.SetAlpha a -> updateCfg $ cfg {C.alpha = a} where loopOn' xc' = signalLoop xc' actions signalv strs loopOn = loopOn' xc updateCfg cfg' = loopOn' (xc {T.config = cfg'}) wakeup = do segs <- parseSegments cfg strs xc' <- updateIconCache xc segs actions' <- runX xc' (Draw.draw segs) signalLoop xc' actions' signalv strs hiderev t sign op | t == 0 = MR.unless (C.persistent cfg) (op d w) >> loopOn | otherwise = do MR.void $ Concurrent.forkIO $ Concurrent.threadDelay (t*100*1000) >> STM.atomically (STM.putTMVar signalv $ sign 0) loopOn toggle t = do ismapped <- W.isMapped d w let s = if ismapped then S.Hide t else S.Reveal t STM.atomically (STM.putTMVar signalv s) loopOn reposWindow rcfg = do r' <- W.repositionWin d w (NE.head fs) rcfg signalLoop (T.XConf d r' w fs is rcfg) actions signalv strs parseSegments :: C.Config -> STM.TVar [String] -> IO [[C.Segment]] parseSegments conf v = do s <- STM.readTVarIO v let l:c:r:_ = s ++ repeat "" return $ map (CT.parseString conf) [l, c, r] updateIconCache :: T.XConf -> [[C.Segment]] -> IO T.XConf updateIconCache xc@(T.XConf d _ w _ c cfg) segs = do let paths = [p | (C.Icon p, _, _, _) <- concat segs] c' <- Bitmap.updateCache d w c (C.iconRoot cfg) paths return $ xc {T.iconCache = c'} updateConfigPosition :: X11.Display -> C.Config -> IO C.Config updateConfigPosition disp cfg = case C.position cfg of C.OnScreen n o -> do srs <- Xinerama.getScreenInfo disp return (if n == length srs then (cfg {C.position = C.OnScreen 1 o}) else (cfg {C.position = C.OnScreen (n+1) o})) o -> return (cfg {C.position = C.OnScreen 1 o}) runActions :: D.Actions -> A.Button -> X11.Position -> IO () runActions actions button pos = mapM_ A.runAction $ filter (\(A.Spawn b _) -> button `elem` b) $ concatMap (\(a,_,_) -> a) $ filter (\(_, from, to) -> pos' >= from && pos' <= to) actions where pos' = fromIntegral pos �����������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/Text.hs������������������������������������������������������������������0000644�0000000�0000000�00000003375�07346545000�015004� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Xmobar.X11.Text -- Copyright : (C) 2011-2015, 2017, 2018, 2022 Jose Antonio Ortega Ruiz -- (C) 2007 Andrea Rossato -- License : BSD3 -- -- Maintainer : jao@gnu.org -- Stability : unstable -- Portability : unportable -- ----------------------------------------------------------------------------- module Xmobar.X11.Text ( XFont , initFont , textExtents , textWidth ) where import qualified Control.Exception as E import qualified Foreign as F import qualified System.Mem.Weak as W import qualified Graphics.X11.Xlib as X import qualified Graphics.X11.Xlib.Extras as Xx type XFont = Xx.FontSet initFont :: X.Display -> String -> IO XFont initFont = initUtf8Font miscFixedFont :: String miscFixedFont = "-misc-fixed-*-*-*-*-*-*-*-*-*-*-*-*" -- | Given a fontname returns the font structure. If the font name is -- not valid the default font will be loaded and returned. initUtf8Font :: X.Display -> String -> IO Xx.FontSet initUtf8Font d s = do (_,_,f) <- E.handle fallBack getIt W.addFinalizer f (Xx.freeFontSet d f) return f where getIt = Xx.createFontSet d s fallBack :: E.SomeException -> IO ([String], String, Xx.FontSet) fallBack = const $ Xx.createFontSet d miscFixedFont textWidth :: X.Display -> XFont -> String -> IO Int textWidth _ fs s = return $ fromIntegral $ Xx.wcTextEscapement fs s textExtents :: XFont -> String -> IO (F.Int32, F.Int32) textExtents fs s = do let (_,rl) = Xx.wcTextExtents fs s ascent = fromIntegral $ negate (X.rect_y rl) descent = fromIntegral $ X.rect_height rl + fromIntegral (X.rect_y rl) return (ascent, descent) �������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/Types.hs�����������������������������������������������������������������0000644�0000000�0000000�00000001773�07346545000�015164� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.Types -- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable -- Portability: portable -- Created: Sat Nov 24, 2018 19:02 -- -- -- The Xmobar basic type -- ------------------------------------------------------------------------------ module Xmobar.X11.Types where import qualified Graphics.X11.Xlib as X11 import qualified Data.List.NonEmpty as NE import Control.Monad.Reader (ReaderT) import Xmobar.Config.Types import Xmobar.X11.Bitmap (BitmapCache) import Xmobar.X11.Text (XFont) -- | The X type is a ReaderT type X = ReaderT XConf IO -- | The ReaderT inner component data XConf = XConf { display :: X11.Display , rect :: X11.Rectangle , window :: X11.Window , fontList :: NE.NonEmpty XFont , iconCache :: BitmapCache , config :: Config } �����xmobar-0.46/src/Xmobar/X11/Window.hs����������������������������������������������������������������0000644�0000000�0000000�00000017753�07346545000�015334� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������----------------------------------------------------------------------------- -- | -- Module : Window -- Copyright : (c) 2011-18, 2020-22 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 Xmobar.X11.Window where import qualified Control.Monad as CM import qualified Data.Function as DF import qualified Data.List as DL import qualified Data.Maybe as DM import qualified Graphics.X11.Xlib as X import qualified Graphics.X11.Xlib.Extras as Xx import qualified Graphics.X11.Xinerama as Xi import qualified Foreign.C.Types as C import qualified System.Posix.Process as PP import qualified Xmobar.Config.Types as T import qualified Xmobar.X11.Text as Txt -- $window -- | Creates a window with the attribute override_redirect set to True. -- Windows Managers should not touch this kind of windows. newWindow :: X.Display -> X.Screen -> X.Window -> X.Rectangle -> Bool -> IO X.Window newWindow dpy scr rw (X.Rectangle x y w h) o = do let visual = X.defaultVisualOfScreen scr attrmask = if o then X.cWOverrideRedirect else 0 X.allocaSetWindowAttributes $ \attributes -> do X.set_override_redirect attributes o X.createWindow dpy rw x y w h 0 (X.defaultDepthOfScreen scr) X.inputOutput visual attrmask attributes -- | The function to create the initial window createWin :: X.Display -> Txt.XFont -> T.Config -> IO (X.Rectangle, X.Window) createWin d fs c = do let dflt = X.defaultScreen d srs <- Xi.getScreenInfo d rootw <- X.rootWindow d dflt (as,ds) <- Txt.textExtents fs "0" let ht = as + ds + 4 r = setPosition c (T.position c) srs (fromIntegral ht) win <- newWindow d (X.defaultScreenOfDisplay d) rootw r (T.overrideRedirect c) setProperties c d win setStruts r c d win srs CM.when (T.lowerOnStart c) $ X.lowerWindow d win CM.unless (T.hideOnStart c) $ showWindow r c d win return (r,win) -- | Updates the size and position of the window repositionWin :: X.Display -> X.Window -> Txt.XFont -> T.Config -> IO X.Rectangle repositionWin d win fs c = do srs <- Xi.getScreenInfo d (as,ds) <- Txt.textExtents fs "0" let ht = as + ds + 4 r = setPosition c (T.position c) srs (fromIntegral ht) X.moveResizeWindow d win (X.rect_x r) (X.rect_y r) (X.rect_width r) (X.rect_height r) setStruts r c d win srs X.sync d False return r fi :: (Integral a, Num b) => a -> b fi = fromIntegral setPosition :: T.Config -> T.XPosition -> [X.Rectangle] -> X.Dimension -> X.Rectangle setPosition c p rs ht = case p' of T.Top -> X.Rectangle rx ry rw h T.TopP l r -> X.Rectangle (rx + fi l) ry (rw - fi l - fi r) h T.TopH ch -> X.Rectangle rx ry rw (mh ch) T.TopHM ch l r t _ -> X.Rectangle (rx + fi l) (ry + fi t) (rw - fi l - fi r) (mh ch) T.TopW a i -> X.Rectangle (ax a i) ry (nw i) h T.TopSize a i ch -> X.Rectangle (ax a i) ry (nw i) (mh ch) T.Bottom -> X.Rectangle rx ny rw h T.BottomH ch -> X.Rectangle rx (ny' ch) rw (mh ch) T.BottomHM ch l r _ b -> X.Rectangle (rx + fi l) (ry + fi rh - fi b - fi (mh ch)) (rw - fi l - fi r) (mh ch) T.BottomW a i -> X.Rectangle (ax a i) ny (nw i) h T.BottomP l r -> X.Rectangle (rx + fi l) ny (rw - fi l - fi r) h T.BottomSize a i ch -> X.Rectangle (ax a i) (ny' ch) (nw i) (mh ch) T.Static cx cy cw ch -> X.Rectangle (fi cx) (fi cy) (fi cw) (fi ch) T.OnScreen _ p'' -> setPosition c p'' [scr] ht where (scr@(X.Rectangle rx ry rw rh), p') = case p of T.OnScreen i x -> (DM.fromMaybe (picker rs) $ safeIndex i rs, x) _ -> (picker 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 T.L = const rx ax T.R = right ax T.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..] picker = if T.pickBroadest c then DL.maximumBy (compare `DF.on` X.rect_width) else head setProperties :: T.Config -> X.Display -> X.Window -> IO () setProperties c d w = do let mkatom n = X.internAtom d n False card <- mkatom "CARDINAL" atom <- mkatom "ATOM" X.setTextProperty d w (T.wmClass c) X.wM_CLASS X.setTextProperty d w (T.wmName c) X.wM_NAME wtype <- mkatom "_NET_WM_WINDOW_TYPE" dock <- mkatom "_NET_WM_WINDOW_TYPE_DOCK" Xx.changeProperty32 d w wtype atom Xx.propModeReplace [fi dock] CM.when (T.allDesktops c) $ do desktop <- mkatom "_NET_WM_DESKTOP" Xx.changeProperty32 d w desktop card Xx.propModeReplace [0xffffffff] pid <- mkatom "_NET_WM_PID" PP.getProcessID >>= Xx.changeProperty32 d w pid card Xx.propModeReplace . return . fi setStruts' :: X.Display -> X.Window -> [C.CLong] -> IO () setStruts' d w svs = do let mkatom n = X.internAtom d n False card <- mkatom "CARDINAL" pstrut <- mkatom "_NET_WM_STRUT_PARTIAL" strut <- mkatom "_NET_WM_STRUT" Xx.changeProperty32 d w pstrut card Xx.propModeReplace svs Xx.changeProperty32 d w strut card Xx.propModeReplace (take 4 svs) setStruts :: X.Rectangle -> T.Config -> X.Display -> X.Window -> [X.Rectangle] -> IO () setStruts r c d w rs = do let svs = map fi $ getStrutValues r (T.position c) (getRootWindowHeight rs) setStruts' d w svs getRootWindowHeight :: [X.Rectangle] -> Int getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs) where getMaxScreenYCoord sr = fi (X.rect_y sr) + fi (X.rect_height sr) getStrutValues :: X.Rectangle -> T.XPosition -> Int -> [Int] getStrutValues r@(X.Rectangle x y w h) p rwh = case p of T.OnScreen _ p' -> getStrutValues r p' rwh T.Top -> [0, 0, st , 0 , 0, 0, 0, 0, nx, nw, 0 , 0 ] T.TopH _ -> [0, 0, st , 0 , 0, 0, 0, 0, nx, nw, 0 , 0 ] T.TopHM _ _ _ _ b -> [0, 0, st+b, 0 , 0, 0, 0, 0, nx, nw, 0 , 0 ] T.TopP _ _ -> [0, 0, st , 0 , 0, 0, 0, 0, nx, nw, 0 , 0 ] T.TopW _ _ -> [0, 0, st , 0 , 0, 0, 0, 0, nx, nw, 0 , 0 ] T.TopSize {} -> [0, 0, st , 0 , 0, 0, 0, 0, nx, nw, 0 , 0 ] T.Bottom -> [0, 0, 0 , sb , 0, 0, 0, 0, 0 , 0 , nx, nw] T.BottomH _ -> [0, 0, 0 , sb , 0, 0, 0, 0, 0 , 0 , nx, nw] T.BottomHM _ _ _ t _ -> [0, 0, 0 , sb+t, 0, 0, 0, 0, 0 , 0 , nx, nw] T.BottomP _ _ -> [0, 0, 0 , sb , 0, 0, 0, 0, 0 , 0 , nx, nw] T.BottomW _ _ -> [0, 0, 0 , sb , 0, 0, 0, 0, 0 , 0 , nx, nw] T.BottomSize {} -> [0, 0, 0 , sb , 0, 0, 0, 0, 0 , 0 , nx, nw] T.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 :: T.XPosition -> Int -> [Int] getStaticStrutValues (T.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 - 1 getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] hideWindow :: X.Display -> X.Window -> IO () hideWindow d w = do setStruts' d w (replicate 12 0) Xx.unmapWindow d w >> X.sync d False showWindow :: X.Rectangle -> T.Config -> X.Display -> X.Window -> IO () showWindow r c d w = do X.mapWindow d w Xi.getScreenInfo d >>= setStruts r c d w X.sync d False isMapped :: X.Display -> X.Window -> IO Bool isMapped d w = ism <$> Xx.getWindowAttributes d w where ism Xx.WindowAttributes { Xx.wa_map_state = wms } = wms /= Xx.waIsUnmapped ���������������������xmobar-0.46/src/Xmobar/X11/XPMFile.hsc��������������������������������������������������������������0000644�0000000�0000000�00000004620�07346545000�015461� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : XPMFile -- Copyright : (C) 2014, 2018 Alexander Shabalin -- License : BSD3 -- -- Maintainer : jao@gnu.org -- Stability : unstable -- Portability : unportable -- ----------------------------------------------------------------------------- module Xmobar.X11.XPMFile(readXPMFile) where #if MIN_VERSION_mtl(2, 2, 1) import Control.Monad.Except(MonadError(..)) #else import Control.Monad.Error(MonadError(..)) #endif import Control.Monad.Trans(MonadIO(..)) import Graphics.X11.Xlib(Dimension, Display(..), Drawable, Pixmap) import Foreign.C.String(CString, withCString) import Foreign.C.Types(CInt(..), CLong) import Foreign.Ptr(Ptr) import Foreign.Marshal.Alloc(alloca, allocaBytes) import Foreign.Storable(peek, peekByteOff, pokeByteOff) #include <X11/xpm.h> foreign import ccall "XpmReadFileToPixmap" xpmReadFileToPixmap :: Display -> Drawable -> CString -> Ptr Pixmap -> Ptr Pixmap -> Ptr () -> IO CInt readXPMFile :: (MonadError String m, MonadIO m) => Display -> Drawable -> String -> m (Dimension, Dimension, Pixmap, Maybe Pixmap) readXPMFile display d filename = toError $ withCString filename $ \c_filename -> alloca $ \pixmap_return -> alloca $ \shapemask_return -> allocaBytes (#size XpmAttributes) $ \attributes -> do (#poke XpmAttributes, valuemask) attributes ((#const XpmReturnAllocPixels) :: CLong) res <- xpmReadFileToPixmap display d c_filename pixmap_return shapemask_return attributes case res of 0 -> do width <- (#peek XpmAttributes, width) attributes height <- (#peek XpmAttributes, height) attributes pixmap <- peek pixmap_return shapemask <- peek shapemask_return return $ Right (width, height, pixmap, if shapemask == 0 then Nothing else Just shapemask) 1 -> return $ Left "readXPMFile: XpmColorError" -1 -> return $ Left "readXPMFile: XpmOpenFailed" -2 -> return $ Left "readXPMFile: XpmFileInvalid" -3 -> return $ Left "readXPMFile: XpmNoMemory" -4 -> return $ Left "readXPMFile: XpmColorFailed" _ -> return $ Left "readXPMFile: Unknown error" where toError m = either throwError return =<< liftIO m ����������������������������������������������������������������������������������������������������������������xmobar-0.46/src/Xmobar/X11/XRender.hsc��������������������������������������������������������������0000644�0000000�0000000�00000012214�07346545000�015562� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.XRender -- Copyright: (c) 2012, 2014, 2015, 2017, 2022 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: Sun Sep 11, 2022 01:27 -- -- -- A couple of utilities imported from libxrender to allow alpha blending of -- an image backgrond. -- ------------------------------------------------------------------------------ {-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} module Xmobar.X11.XRender (drawBackground) where import Graphics.X11 import Graphics.X11.Xrender import Graphics.X11.Xlib.Extras (xGetWindowProperty, xFree) import Control.Monad (when) import Foreign import Foreign.C.Types #include <X11/extensions/Xrender.h> type Picture = XID type PictOp = CInt data XRenderPictFormat data XRenderPictureAttributes = XRenderPictureAttributes -- foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFillRectangle" -- xRenderFillRectangle :: Display -> PictOp -> Picture -> Ptr XRenderColor -> CInt -> CInt -> CUInt -> CUInt -> IO () foreign import ccall unsafe "X11/extensions/Xrender.h XRenderComposite" xRenderComposite :: Display -> PictOp -> Picture -> Picture -> Picture -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> CUInt -> CUInt -> IO () foreign import ccall unsafe "X11/extensions/Xrender.h XRenderCreateSolidFill" xRenderCreateSolidFill :: Display -> Ptr XRenderColor -> IO Picture foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFreePicture" xRenderFreePicture :: Display -> Picture -> IO () foreign import ccall unsafe "string.h" memset :: Ptr a -> CInt -> CSize -> IO () foreign import ccall unsafe "X11/extensions/Xrender.h XRenderFindStandardFormat" xRenderFindStandardFormat :: Display -> CInt -> IO (Ptr XRenderPictFormat) foreign import ccall unsafe "X11/extensions/Xrender.h XRenderCreatePicture" xRenderCreatePicture :: Display -> Drawable -> Ptr XRenderPictFormat -> CULong -> Ptr XRenderPictureAttributes -> IO Picture -- Attributes not supported instance Storable XRenderPictureAttributes where sizeOf _ = #{size XRenderPictureAttributes} alignment _ = alignment (undefined :: CInt) peek _ = return XRenderPictureAttributes poke p XRenderPictureAttributes = memset p 0 #{size XRenderPictureAttributes} -- | Convenience function, gives us an XRender handle to a traditional -- Pixmap. Don't let it escape. withRenderPicture :: Display -> Drawable -> (Picture -> IO a) -> IO () withRenderPicture d p f = do format <- xRenderFindStandardFormat d 1 -- PictStandardRGB24 alloca $ \attr -> do pic <- xRenderCreatePicture d p format 0 attr f pic xRenderFreePicture d pic -- | Convenience function, gives us an XRender picture that is a solid -- fill of color 'c'. Don't let it escape. withRenderFill :: Display -> XRenderColor -> (Picture -> IO a) -> IO () withRenderFill d c f = do pic <- with c (xRenderCreateSolidFill d) f pic xRenderFreePicture d pic -- | Drawing the background to a pixmap and taking into account -- transparency drawBackground :: Display -> Drawable -> String -> Int -> Rectangle -> IO () drawBackground d p bgc alpha (Rectangle x y wid ht) = do let render opt bg pic m = xRenderComposite d opt bg m pic (fromIntegral x) (fromIntegral y) 0 0 0 0 (fromIntegral wid) (fromIntegral ht) withRenderPicture d p $ \pic -> do -- Handle background color bgcolor <- parseRenderColor d bgc withRenderFill d bgcolor $ \bgfill -> withRenderFill d (XRenderColor 0 0 0 (257 * alpha)) (render pictOpSrc bgfill pic) -- Handle transparency internAtom d "_XROOTPMAP_ID" False >>= \xid -> let xroot = defaultRootWindow d in alloca $ \x1 -> alloca $ \x2 -> alloca $ \x3 -> alloca $ \x4 -> alloca $ \pprop -> do xGetWindowProperty d xroot xid 0 1 False 20 x1 x2 x3 x4 pprop prop <- peek pprop when (prop /= nullPtr) $ do rootbg <- peek (castPtr prop) :: IO Pixmap xFree prop withRenderPicture d rootbg $ \bgpic -> withRenderFill d (XRenderColor 0 0 0 (0xFFFF - 257 * alpha)) (render pictOpAdd bgpic pic) -- | Parses color into XRender color (allocation not necessary!) parseRenderColor :: Display -> String -> IO XRenderColor parseRenderColor d c = do let colormap = defaultColormap d (defaultScreen d) Color _ red green blue _ <- parseColor d colormap c return $ XRenderColor (fromIntegral red) (fromIntegral green) (fromIntegral blue) 0xFFFF pictOpSrc, pictOpAdd :: PictOp pictOpSrc = 1 pictOpAdd = 12 -- pictOpMinimum = 0 -- pictOpClear = 0 -- pictOpDst = 2 -- pictOpOver = 3 -- pictOpOverReverse = 4 -- pictOpIn = 5 -- pictOpInReverse = 6 -- pictOpOut = 7 -- pictOpOutReverse = 8 -- pictOpAtop = 9 -- pictOpAtopReverse = 10 -- pictOpXor = 11 -- pictOpSaturate = 13 -- pictOpMaximum = 13 ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/test/�����������������������������������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�012103� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/test/Spec.hs����������������������������������������������������������������������������0000644�0000000�0000000�00000000053�07346545000�013327� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# OPTIONS_GHC -F -pgmF hspec-discover #-}�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/test/Xmobar/Plugins/Monitors/�����������������������������������������������������������0000755�0000000�0000000�00000000000�07346545000�016566� 5����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/test/Xmobar/Plugins/Monitors/AlsaSpec.hs������������������������������������������������0000644�0000000�0000000�00000012570�07346545000�020622� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������{-# OPTIONS_GHC -Wall #-} {-# LANGUAGE CPP #-} module Xmobar.Plugins.Monitors.AlsaSpec ( main , spec ) where #ifdef ALSA import Control.Concurrent import Control.Concurrent.Async import Control.Monad import System.FilePath import System.IO import System.IO.Temp import System.Posix.Files import System.Process import Test.Hspec import Xmobar.Plugins.Monitors.Alsa main :: IO () main = hspec spec spec :: Spec spec = do describe "Alsa.getWaitMonitor" $ it "produces the expected timeline (using a fake alsactl)" runFakeAlsactlTest describe "Alsa.parseOptsIncludingMonitorArgs" $ do it "works with empty args" $ do opts <- parseOptsIncludingMonitorArgs [] aoAlsaCtlPath opts `shouldBe` Nothing it "parses --alsactl=foo" $ do opts <- parseOptsIncludingMonitorArgs ["--", "--alsactl=foo"] aoAlsaCtlPath opts `shouldBe` Just "foo" runFakeAlsactlTest :: Expectation runFakeAlsactlTest = withSystemTempDirectory "xmobar-test" $ \tmpDir -> do let fifoPath = tmpDir </> "fifo" fakeAlsactlPath = tmpDir </> "fake-alsactl" writeFile fakeAlsactlPath $ unlines [ "#!/bin/bash" , "[[ $1 == monitor ]] || exit 99" , "exec cat \"$2\"" ] setFileMode fakeAlsactlPath ownerModes withFifoWriteHandle fifoPath $ \fifo -> do timeline <- newMVar [] :: IO (MVar [TimelineEntry]) runVolumeCompleted <- newEmptyMVar :: IO (MVar Bool) -- True -> quit waiterTaskIsRunning <- newEmptyMVar :: IO (MVar ()) waiterTaskIsWaiting <- newEmptyMVar :: IO (MVar ()) let outputCallback msg = fail ("Did not expect the output callback to be invoked (message: "++show msg++")") withMonitorWaiter fifoPath (Just fakeAlsactlPath) outputCallback $ \waitFunc -> do let addToTimeline e = modifyMVar_ timeline (pure . (e :)) emitEvent = do addToTimeline EventEmitted hPutStrLn fifo "#17 (2,0,0,Master Playback Volume,0) VALUE" hFlush fifo putNow mv val = do ok <- tryPutMVar mv val unless ok $ expectationFailure "Expected the MVar to be empty" simulateRunVolumeCompleted = putNow runVolumeCompleted False quitWaiter = putNow runVolumeCompleted True waiterTaskMain = do addToTimeline RunVolume putNow waiterTaskIsRunning () q <- takeMVar runVolumeCompleted unless q $ do addToTimeline Waiting putNow waiterTaskIsWaiting () waitFunc waiterTaskMain delay_ms = threadDelay . (* 1000) withAsync waiterTaskMain $ \waiterTask -> do takeMVar waiterTaskIsRunning simulateRunVolumeCompleted takeMVar waiterTaskIsWaiting takeMVar waiterTaskIsRunning -- Waiter returns instantly once simulateRunVolumeCompleted takeMVar waiterTaskIsWaiting emitEvent takeMVar waiterTaskIsRunning simulateRunVolumeCompleted takeMVar waiterTaskIsWaiting let iters = 3 burstSize = 5 replicateM_ iters $ do emitEvent takeMVar waiterTaskIsRunning -- Now more events start to accumulate during runVolume replicateM_ burstSize emitEvent delay_ms 250 -- Give the events time to go through the pipe simulateRunVolumeCompleted -- runVolume completed and should run once more due to -- accumulated events takeMVar waiterTaskIsWaiting takeMVar waiterTaskIsRunning simulateRunVolumeCompleted takeMVar waiterTaskIsWaiting emitEvent takeMVar waiterTaskIsRunning quitWaiter wait waiterTask timelineValue <- reverse <$> readMVar timeline timelineValue `shouldBe` [RunVolume, Waiting, RunVolume, Waiting, EventEmitted, RunVolume, Waiting] ++ concat (replicate iters $ [EventEmitted, RunVolume] ++ replicate burstSize EventEmitted ++ [Waiting, RunVolume, Waiting]) ++ [EventEmitted, RunVolume] data TimelineEntry = EventEmitted | Waiting | RunVolume deriving(Eq) instance Show TimelineEntry where show x = case x of EventEmitted -> "E" Waiting -> "W" RunVolume -> "R" withFifoWriteHandle :: FilePath -> (Handle -> IO b) -> IO b withFifoWriteHandle fifoPath body = do createNamedPipe fifoPath ownerModes -- Can't seem to get the writing to the FIFO to work internally withCreateProcess (proc "bash" ["-c", "cat >> \"$0\"", fifoPath]) {std_in = CreatePipe} $ \(Just h) _ _ _ -> do hSetBuffering h LineBuffering body h #else -- These No-Op values are required for HSpec's test discovery. main :: IO () main = return () spec :: Monad m => m () spec = return () #endif ����������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/test/Xmobar/Plugins/Monitors/CommonSpec.hs����������������������������������������������0000644�0000000�0000000�00000001753�07346545000�021173� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Xmobar.Plugins.Monitors.CommonSpec ( main , spec ) where import Test.Hspec import Xmobar.Plugins.Monitors.Common main :: IO () main = hspec spec spec :: Spec spec = describe "Common.padString" $ do it "returns given string when called with default values" $ padString 0 0 "" False "" "test" `shouldBe` "test" it "truncates to max width" $ do let maxw = 3 givenStr = "mylongstr" expectedStr = take maxw givenStr padString 0 maxw "" False "" givenStr `shouldBe` expectedStr it "truncates to max width and concatenate with ellipsis" $ do let maxw = 3 givenStr = "mylongstr" ellipsis = "..." expectedStr = (++ ellipsis) . take 3 $ givenStr padString 0 maxw "" False ellipsis givenStr `shouldBe` expectedStr it "does not pad empty strings" $ do let padChars = " " givenStr = "" expectedStr = "" padString 0 0 padChars False "" givenStr `shouldBe` expectedStr ���������������������xmobar-0.46/test/Xmobar/Plugins/Monitors/CpuSpec.hs�������������������������������������������������0000644�0000000�0000000�00000003506�07346545000�020470� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������module Xmobar.Plugins.Monitors.CpuSpec ( spec, main ) where import Test.Hspec import Xmobar.Plugins.Monitors.Common import Xmobar.Plugins.Monitors.Cpu import Data.List main :: IO () main = hspec spec spec :: Spec spec = describe "CPU Spec" $ do it "works with total template" $ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>%"] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs cpuValue `shouldSatisfy` (\item -> "Cpu:" `isPrefixOf` item) it "works with bar template" $ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>% <bar>"] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs cpuValue `shouldSatisfy` (all (`elem` ":#") . last . words) it "works with no icon pattern template" $ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>% <bar>", "--", "--load-icon-pattern", "<icon=bright_%%.xpm/>"] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs cpuValue `shouldSatisfy` (\item -> not $ "<icon=bright_" `isInfixOf` cpuValue) it "works with icon pattern template" $ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>% <bar> <ipat>", "--", "--load-icon-pattern", "<icon=bright_%%.xpm/>"] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs cpuValue `shouldSatisfy` (\item -> "<icon=bright_" `isInfixOf` cpuValue) it "works with other parameters in template" $ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <user> <nice> <iowait>"] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs cpuValue `shouldSatisfy` (\item -> "Cpu:" `isPrefixOf` cpuValue) ������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������xmobar-0.46/xmobar.cabal����������������������������������������������������������������������������0000644�0000000�0000000�00000035077�07346545000�013414� 0����������������������������������������������������������������������������������������������������ustar�00����������������������������������������������������������������0000000�0000000������������������������������������������������������������������������������������������������������������������������������������������������������������������������name: xmobar version: 0.46 homepage: https://codeberg.org/xmobar/xmobar synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. . Inspired by the Ion3 status bar, it supports similar features, like dynamic color management, output templates, and extensibility through plugins. category: System license: BSD3 license-file: license author: Andrea Rossato and Jose A. Ortega Ruiz maintainer: Jose A. Ortega Ruiz <jao@gnu.org> bug-reports: https://codeberg.org/xmobar/xmobar/issues cabal-version: >= 1.10 build-type: Simple extra-source-files: readme.org, changelog.md, doc/quick-start.org, doc/plugins.org, doc/compiling.org, doc/using-haskell.org, etc/padding-icon.sh, etc/xmobar.config, etc/xmobar.hs, etc/xmonadpropwrite.hs, etc/xmobar.el source-repository head type: git location: git://codeberg.org/xmobar/xmobar.git branch: master flag with_xrender description: Use XRender for alpha background pseudo-transparency. default: True flag with_inotify description: inotify support (modern Linux only). Required for the Mail and MBox plugins. default: False flag with_iwlib description: Wireless info support via Wext ioctls (deprecated). Required for the Wireless plugin, needs iwlib installed. default: False flag with_nl80211 description: Wireless info support via nl80211. Required for the Wireless plugin on systems running Linux, the kernel. default: False flag with_mpd description: MPD support. Needs libmpd installed. default: False flag all_extensions description: Includes all optional extensions. default: False flag with_alsa description: Use alsa-mixer to get the volume from soundcards. default: False flag with_datezone description: Enables localized date support. default: False flag with_mpris 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_xpm description: Enable usage of xpm for icons. default: False flag with_threaded description: Use threaded runtime. Required for timer coalescing (less power usage). default: False flag with_rtsopts description: Use -with-rtsopts=-V0 to reduce wakeups. default: True flag with_weather description: Enable weather plugin. default: True flag with_uvmeter description: UVMeter only useful to australians. default: False flag with_kraken description: Enable Kraken plugin. default: False library default-language: Haskell2010 hs-source-dirs: src exposed-modules: Xmobar, Xmobar.Plugins.Monitors.Common.Types, Xmobar.Plugins.Monitors.Common.Run, Xmobar.Plugins.Monitors.Common, Xmobar.Plugins.Monitors.Cpu other-modules: Paths_xmobar, Xmobar.Config.Types, Xmobar.Config.Parse, Xmobar.Config.Template, Xmobar.Run.Types, Xmobar.Run.Timer, Xmobar.Run.Template, Xmobar.Run.Exec, Xmobar.Run.Runnable Xmobar.Run.Actions, Xmobar.Run.Loop, Xmobar.Draw.Boxes, Xmobar.Draw.Cairo, Xmobar.Draw.Types, Xmobar.App.Config, Xmobar.App.Main, Xmobar.App.Opts, Xmobar.App.Compile, Xmobar.System.Utils, Xmobar.System.StatFS, Xmobar.System.Environment, Xmobar.System.Localize, Xmobar.System.Signal, Xmobar.System.Kbd, Xmobar.Text.Ansi, Xmobar.Text.Loop, Xmobar.Text.Pango, Xmobar.Text.Swaybar, Xmobar.Text.SwaybarClicks, Xmobar.Text.Output, Xmobar.X11.Bitmap, Xmobar.X11.CairoSurface, Xmobar.X11.ColorCache, Xmobar.X11.Draw, Xmobar.X11.Events, Xmobar.X11.Loop, Xmobar.X11.Text, Xmobar.X11.Types, Xmobar.X11.Window, Xmobar.Plugins.Command, Xmobar.Plugins.BufferedPipeReader, Xmobar.Plugins.CommandReader, Xmobar.Plugins.Date, Xmobar.Plugins.EWMH, Xmobar.Plugins.HandleReader, Xmobar.Plugins.QueueReader, Xmobar.Plugins.PipeReader, Xmobar.Plugins.MarqueePipeReader, Xmobar.Plugins.StdinReader, Xmobar.Plugins.XMonadLog, Xmobar.Plugins.Kbd, Xmobar.Plugins.Locks, Xmobar.Plugins.NotmuchMail, Xmobar.Plugins.Monitors, Xmobar.Plugins.Monitors.Batt, Xmobar.Plugins.Monitors.Batt.Common, Xmobar.Plugins.Monitors.Common.Output, Xmobar.Plugins.Monitors.Common.Parsers, Xmobar.Plugins.Monitors.Common.Files, Xmobar.Plugins.Monitors.CoreTemp, Xmobar.Plugins.Monitors.K10Temp, Xmobar.Plugins.Monitors.Cpu.Common, Xmobar.Plugins.Monitors.CpuFreq, Xmobar.Plugins.Monitors.Disk, Xmobar.Plugins.Monitors.Disk.Common, Xmobar.Plugins.Monitors.Load, Xmobar.Plugins.Monitors.Load.Common, Xmobar.Plugins.Monitors.Mem, Xmobar.Plugins.Monitors.MultiCoreTemp, Xmobar.Plugins.Monitors.MultiCpu, Xmobar.Plugins.Monitors.Net, Xmobar.Plugins.Monitors.Net.Common, Xmobar.Plugins.Monitors.Swap, Xmobar.Plugins.Monitors.Thermal, Xmobar.Plugins.Monitors.ThermalZone, Xmobar.Plugins.Monitors.Top, Xmobar.Plugins.Monitors.Top.Common, Xmobar.Plugins.Monitors.Uptime, Xmobar.Plugins.Monitors.Bright, Xmobar.Plugins.Monitors.CatInt extra-libraries: Xrandr Xrender ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind build-depends: aeson >= 1.4.7.1, async, base >= 4.11.0 && < 4.18, bytestring >= 0.10.8.2, cairo >= 0.13, colour >= 2.3.6, containers, directory, extensible-exceptions == 0.1.*, filepath, mtl >= 2.1 && < 2.3, old-locale, pango >= 0.13, parsec == 3.1.*, parsec-numbers >= 0.1.0, process, regex-compat, stm >= 2.3 && < 2.6, time, transformers, unix, utf8-string >= 0.3 && < 1.1, X11 >= 1.6.1 if impl(ghc < 8.0.2) -- Disable building with GHC before 8.0.2. -- Due to a cabal bug, do not use buildable: False, -- but instead give it an impossible constraint. -- See: https://github.com/haskell-infra/hackage-trustees/issues/165 build-depends: unsupported-ghc-version > 1 && < 1 if flag(with_threaded) -- -threaded is a workaround for 100% CPU busy loop -- (http://hackage.haskell.org/trac/ghc/ticket/4934). -- See also comments in https://codeberg.org/xmobar/xmobar/pulls/36 cpp-options: -DTHREADED_RUNTIME if flag(with_rtsopts) cpp-options: -DRTSOPTS if flag(with_xrender) build-depends: X11-xft >= 0.2 other-modules: Xmobar.X11.XRender cpp-options: -DXRENDER if flag(with_inotify) || flag(all_extensions) build-depends: hinotify >= 0.3 && < 0.5 other-modules: Xmobar.Plugins.Mail, Xmobar.Plugins.MBox cpp-options: -DINOTIFY if flag(with_iwlib) || flag(with_nl80211) || flag(all_extensions) other-modules: Xmobar.Plugins.Monitors.Wireless if flag(with_iwlib) extra-libraries: iw build-depends: iwlib >= 0.1.0 && < 0.2 cpp-options: -DIWLIB if !flag(with_iwlib) && (flag(with_nl80211) || flag(all_extensions)) build-depends: netlink >= 1.1.1.0, cereal >= 0.5.8.1 cpp-options: -DUSE_NL80211 if flag(with_mpd) || flag(all_extensions) build-depends: libmpd >= 0.9.2.0 other-modules: Xmobar.Plugins.Monitors.MPD cpp-options: -DLIBMPD if flag(with_alsa) || flag(all_extensions) build-depends: alsa-mixer >= 0.3 && < 0.4 build-depends: alsa-core == 0.5.*, process >= 1.4.3.0 other-modules: Xmobar.Plugins.Monitors.Volume, Xmobar.Plugins.Monitors.Alsa cpp-options: -DALSA if flag(with_datezone) || flag(all_extensions) build-depends: timezone-olson >= 0.2 && < 0.3, timezone-series == 0.1.* other-modules: Xmobar.Plugins.DateZone cpp-options: -DDATEZONE if flag(with_mpris) || flag(all_extensions) build-depends: dbus >= 1 other-modules: Xmobar.Plugins.Monitors.Mpris cpp-options: -DMPRIS if flag(with_dbus) || flag(all_extensions) build-depends: dbus >= 1 other-modules: Xmobar.System.DBus cpp-options: -DDBUS if flag(with_xpm) || flag(all_extensions) extra-libraries: Xpm other-modules: Xmobar.X11.XPMFile cpp-options: -DXPM if flag(with_weather) || flag(all_extensions) other-modules: Xmobar.Plugins.Monitors.Weather cpp-options: -DWEATHER build-depends: http-conduit, http-types, http-client-tls if flag(with_uvmeter) other-modules: Xmobar.Plugins.Monitors.UVMeter build-depends: http-conduit, http-types cpp-options: -DUVMETER if flag(with_kraken) other-modules: Xmobar.Plugins.Kraken build-depends: aeson == 1.5.6.* , text == 1.2.4.* , unordered-containers == 0.2.14.* , vector == 0.12.3.* , wuss == 1.1.* , websockets == 0.12.* cpp-options: -DKRAKEN if os(freebsd) -- enables freebsd specific code extra-libraries: procstat , kvm , geom build-depends: bsd-sysctl other-modules: Xmobar.Plugins.Monitors.Batt.FreeBSD, Xmobar.Plugins.Monitors.Cpu.FreeBSD, Xmobar.Plugins.Monitors.Disk.FreeBSD, Xmobar.Plugins.Monitors.Load.FreeBSD, Xmobar.Plugins.Monitors.Mem.FreeBSD, Xmobar.Plugins.Monitors.Net.FreeBSD, Xmobar.Plugins.Monitors.Swap.FreeBSD, Xmobar.Plugins.Monitors.Top.FreeBSD, Xmobar.Plugins.Monitors.Uptime.FreeBSD else other-modules: Xmobar.Plugins.Monitors.Batt.Linux, Xmobar.Plugins.Monitors.Cpu.Linux, Xmobar.Plugins.Monitors.Disk.Linux, Xmobar.Plugins.Monitors.Load.Linux, Xmobar.Plugins.Monitors.Mem.Linux, Xmobar.Plugins.Monitors.Net.Linux, Xmobar.Plugins.Monitors.Swap.Linux, Xmobar.Plugins.Monitors.Top.Linux, Xmobar.Plugins.Monitors.Uptime.Linux executable xmobar default-language: Haskell2010 hs-source-dirs: app main-is: Main.hs build-depends: X11, async, base, containers, directory, filepath, parsec, unix, xmobar ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind if flag(with_rtsopts) ghc-options: -with-rtsopts=-V0 if flag(with_threaded) ghc-options: -threaded cpp-options: -DTHREADED_RUNTIME test-suite XmobarTest default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: src, test main-is: Spec.hs build-depends: X11, async, base, bytestring, containers, directory, filepath, hspec == 2.*, mtl, old-locale, parsec, parsec-numbers, process, regex-compat, stm, temporary, time, transformers, unix, xmobar other-modules: Xmobar.Plugins.Monitors.CommonSpec Xmobar.Plugins.Monitors.Common Xmobar.Plugins.Monitors.Common.Parsers Xmobar.Plugins.Monitors.Common.Types Xmobar.Plugins.Monitors.Common.Output Xmobar.Plugins.Monitors.Common.Files Xmobar.Plugins.Monitors.Cpu Xmobar.Plugins.Monitors.Cpu.Common Xmobar.Plugins.Monitors.CpuSpec Xmobar.Plugins.Monitors.Common.Run Xmobar.Run.Exec Xmobar.Run.Timer Xmobar.System.Signal if flag(with_alsa) || flag(all_extensions) build-depends: alsa-mixer, alsa-core, process >= 1.4.3.0 other-modules: Xmobar.Plugins.Monitors.Volume Xmobar.Plugins.Monitors.Alsa Xmobar.Plugins.Monitors.AlsaSpec cpp-options: -DALSA if os(freebsd) -- enables freebsd specific code build-depends: bsd-sysctl other-modules: Xmobar.Plugins.Monitors.Cpu.FreeBSD else other-modules: Xmobar.Plugins.Monitors.Cpu.Linux benchmark xmobarbench type: exitcode-stdio-1.0 main-is: main.hs hs-source-dirs: bench ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind -O2 build-depends: base, gauge, mtl, time, xmobar default-language: Haskell2010 ���������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������