diff -pruN 0.36-2/bench/main.hs 0.46-1/bench/main.hs --- 0.36-2/bench/main.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/bench/main.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,32 +1,39 @@ -{-#LANGUAGE RecordWildCards#-} +module Main (main) where +import Data.IORef (newIORef) +import Data.Time import Gauge import Xmobar -import Xmobar.Plugins.Monitors.Common.Types -import Xmobar.Plugins.Monitors.Common.Run import Xmobar.Plugins.Monitors.Cpu -import Control.Monad.Reader -import Data.IORef (newIORef) main :: IO () main = do - cpuParams <- mkCpuArgs - defaultMain $ normalBench cpuParams - where - normalBench args = [ bgroup "Cpu Benchmarks" $ normalCpuBench args] - -runMonitor :: MConfig -> Monitor a -> IO a -runMonitor config r = runReaderT r config + defaultMain =<< sequence [cpuBench, dateBench] mkCpuArgs :: IO CpuArguments -mkCpuArgs = getArguments ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: %"] - --- | The action which will be benchmarked -cpuAction :: CpuArguments -> IO String -cpuAction = runCpu - -cpuBenchmark :: CpuArguments -> Benchmarkable -cpuBenchmark cpuParams = nfIO $ cpuAction cpuParams +mkCpuArgs = getArguments ["-L", "3", "-H", "50", "--normal", "green", "--high", "red", "-t", "Cpu: %"] -normalCpuBench :: CpuArguments -> [Benchmark] -normalCpuBench args = [bench "CPU normal args" (cpuBenchmark args)] +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 diff -pruN 0.36-2/changelog.md 0.46-1/changelog.md --- 0.36-2/changelog.md 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/changelog.md 2001-09-09 01:46:40.000000000 +0000 @@ -1,3 +1,124 @@ +## 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_ @@ -23,7 +144,7 @@ _Bug fixes_ _New features_ - `MultiCoreTemp` now works with Ryzen processors. New option - `--hwmonitor-path` for better performance. + `--hwmon-path` for better performance. - CPU Monitor optimizations. - Version bumps for some dependencies, including timezone-olson. @@ -90,7 +211,7 @@ _Bug fixes_ - Fixed compilation with GHC 8.8.x (thanks to Vanessa McHale). - Avoid creating `~/.xmobar` ([issue #405]). -[issue #405]: https://github.com/jaor/xmobar/issues/405 +[issue #405]: https://codeberg.org/xmobar/xmobar/issues/405 ## Version 0.31 (October, 2019) @@ -100,7 +221,7 @@ _New features_ without padding (see [issue #388]). - New version of libmpd (0.9.0.10), thanks to John Tyree -[issue #388]: https://github.com/jaor/xmobar/issues/388 +[issue #388]: https://codeberg.org/xmobar/xmobar/issues/388 ## Version 0.30 (August, 2019) @@ -115,7 +236,7 @@ _New features_ specify a system command executed if battery left goes beyond a given threshold. -[issue #390]: https://github.com/jaor/xmobar/issues/390 +[issue #390]: https://codeberg.org/xmobar/xmobar/issues/390 ## Version 0.29.5 (March, 2019) @@ -139,7 +260,7 @@ _Bug fixes_ - Upper bound for alsa_mixer (see [issue #372]) -[issue #372]: https://github.com/jaor/xmobar/issues/372 +[issue #372]: https://codeberg.org/xmobar/xmobar/issues/372 ## Version 0.29.2 (December, 2018) @@ -147,7 +268,7 @@ _Bug fixes_ - Work as usual with .xmobarrc (see [issue #371]). -[issue #371]: https://github.com/jaor/xmobar/issues/371 +[issue #371]: https://codeberg.org/xmobar/xmobar/issues/371 ## Version 0.29.1 (December, 2018) @@ -156,7 +277,7 @@ _Bug fixes_ - Honour command line flags (fixes [issue #370]). - Expose Cmd and CmdX in Xmobar interface. -[issue #370]: https://github.com/jaor/xmobar/issues/370 +[issue #370]: https://codeberg.org/xmobar/xmobar/issues/370 ## Version 0.29 (December, 2018) @@ -177,13 +298,13 @@ _Bug fixes_ - Correctly parsing configuration options `mwClass` and `wmName`. -[issue #369]: https://github.com/jaor/xmobar/issues/369 +[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://github.com/jaor/xmobar/issues/354 +[issue #354]: https://codeberg.org/xmobar/xmobar/issues/354 ## Version 0.28 (August, 2018) @@ -195,7 +316,7 @@ _Bug fixes_ - hinotify version upgraded ([issue #356]) -[issue #356]: https://github.com/jaor/xmobar/issues/356 +[issue #356]: https://codeberg.org/xmobar/xmobar/issues/356 ## Version 0.27 (July, 2018) @@ -211,8 +332,8 @@ _Bug fixes_ - Use the maximum width options `-T` and `-E` correctly when a monitor subtemplate contains font and color tags. -[issue #311]: https://github.com/jaor/xmobar/issues/311 -[issue #352]: https://github.com/jaor/xmobar/issues/352 +[issue #311]: https://codeberg.org/xmobar/xmobar/issues/311 +[issue #352]: https://codeberg.org/xmobar/xmobar/issues/352 ## Version 0.26 (April, 2018) @@ -230,9 +351,9 @@ _Bug fixes_ - Race condition in network monitor fixed ([issue #347]). - Limiting dbus supported version (see [issue #346]). -[issue #335]: https://github.com/jaor/xmobar/issues/335 -[issue #346]: https://github.com/jaor/xmobar/issues/346 -[issue #347]: https://github.com/jaor/xmobar/issues/347 +[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) @@ -248,8 +369,8 @@ _Bug fixes_ - Honouring -x in MPris monitor ([issue #325]) -[issue #323]: https://github.com/jaor/xmobar/issues/323 -[issue #325]: https://github.com/jaor/xmobar/issues/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) @@ -257,7 +378,7 @@ _Bug fixes_ - Fix for vertical bars ([issue #303]) -[issue #303]: https://github.com/jaor/xmobar/issues/303 +[issue #303]: https://codeberg.org/xmobar/xmobar/issues/303 ## Version 0.24.4 (April, 2017) @@ -277,7 +398,7 @@ _Bug fixes_ - Better fatal error messages (Michael Bishop). - More paths to read from in CoreTemp (see [issue #291]). -[issue #291]: https://github.com/jaor/xmobar/issues/291 +[issue #291]: https://codeberg.org/xmobar/xmobar/issues/291 ## Version 0.24.3 (Sep 5, 2016) @@ -286,7 +407,7 @@ _Bug fixes_ - Battery monitor: fixes for cases where status is not consistently reported by the kernel (see [issue #271]). -[issue #271]: https://github.com/jaor/xmobar/issues/271 +[issue #271]: https://codeberg.org/xmobar/xmobar/issues/271 ## Version 0.24.2 (Aug 8, 2016) @@ -294,7 +415,7 @@ _Bug fixes_ - New Weather plugin URL (see [issue #270]). -[issue #270]: https://github.com/jaor/xmobar/issues/270 +[issue #270]: https://codeberg.org/xmobar/xmobar/issues/270 ## Version 0.24.1 (Jul 28, 2016) @@ -302,7 +423,7 @@ _Bug fixes_ - Restoring compatibility with GHC 7.6, (see [issue #269]). -[issue #269]: https://github.com/jaor/xmobar/issues/269 +[issue #269]: https://codeberg.org/xmobar/xmobar/issues/269 ## Version 0.24 (Jul 26, 2016) @@ -337,9 +458,9 @@ _Bug fixes_ - `Batt`: sensible thresholds for high/low power consumption (see [issue #265]). -[issue #231]: https://github.com/jaor/xmobar/issues/225 -[issue #265]: https://github.com/jaor/xmobar/issues/225 -[issue #268]: https://github.com/jaor/xmobar/issues/268 +[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) @@ -352,10 +473,10 @@ _Bug fixes_ - Compilation with ghc 7.8 and 7.10 (thanks to Edward Tjörnhammar, see [issue #225]). -[issue #225]: https://github.com/jaor/xmobar/issues/225 -[issue #221]: https://github.com/jaor/xmobar/issues/221 -[issue #216]: https://github.com/jaor/xmobar/issues/216 -[issue #215]: https://github.com/jaor/xmobar/issues/215 +[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) @@ -373,9 +494,9 @@ _New features_ discussion in [issue #171] and [issue #201]). - New template variable `flags` in `MPD` monitor, by Duncan Burke. -[issue #171]: https://github.com/jaor/xmobar/issues/171 -[issue #201]: https://github.com/jaor/xmobar/issues/201 -[issue #114]: https://github.com/jaor/xmobar/issues/114 +[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_ @@ -383,7 +504,7 @@ _Bug fixes_ - Better `Weather` parsing of wind direction, by Dino Morelli (see [pull #212]). -[pull #212]: https://github.com/jaor/xmobar/pull/212 +[pull #212]: https://codeberg.org/xmobar/xmobar/pulls/212 ## Version 0.22.1 (Oct 11, 2014) @@ -424,11 +545,11 @@ _Bug fixes_ - Avoiding zombies on click actions, thanks to Phil Xiaojun Hu ([issue #181]). -[issue #181]: https://github.com/jaor/xmobar/issues/181 -[issue #189]: https://github.com/jaor/xmobar/issues/189 -[pull request #192]: https://github.com/jaor/xmobar/pull/192 -[pull request #195]: https://github.com/jaor/xmobar/pull/195 -[pull request #196]: https://github.com/jaor/xmobar/pull/196 +[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) @@ -449,7 +570,7 @@ _Bug fixes_ [issue #89]). - Fix for very long running `Cpu` monitors, by Robert J Macomber. -[issue #89]: https://github.com/jaor/xmobar/issues/89 +[issue #89]: https://codeberg.org/xmobar/xmobar/issues/89 ## Version 0.20.1 (March 13, 2014) @@ -459,7 +580,7 @@ _New features_ configuration option, `pickBroadest`, for choosing the broadest (see [issue #158]). -[issue #158]: https://github.com/jaor/xmobar/issues/158 +[issue #158]: https://codeberg.org/xmobar/xmobar/issues/158 ## Version 0.20 (March 10, 2014) @@ -483,60 +604,60 @@ _Bug fixes_ see [issue #133]). - Compatibility with latest `directory` (1.2.0.2). -[issue #76]: https://github.com/jaor/xmobar/issues/76 -[issue #111]: https://github.com/jaor/xmobar/issues/111 -[issue #133]: https://github.com/jaor/xmobar/issues/133 -[issue #139]: https://github.com/jaor/xmobar/issues/133 +[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 [Github's tracker] for new bugs. +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 - [github #99]). + [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. [github #127]). + "/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 [github #125]). + (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. [github #119]. + (defaulting to "N/A"). Cf. [codeberg #119]. _Bug fixes_ - Using the width options `-w`, `-m` and `-M` in battery monitors - watts display ([github #118]). - - Using the `-d` option in `CoreTemp` ([github #115]) + 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 - [github #117]). + [codeberg #117]). - Weather monitor: support for stations without name (Sergei Trofimovich, [issue #65]). -[Github's tracker]: https://github.com/jaor/xmobar/issues -[github #99]: https://github.com/jaor/xmobar/issues/115 -[github #115]: https://github.com/jaor/xmobar/issues/115 -[github #117]: https://github.com/jaor/xmobar/issues/117 -[github #125]: https://github.com/jaor/xmobar/issues/125 +[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 -[github #118]: https://github.com/jaor/xmobar/issues/118 -[github #119]: https://github.com/jaor/xmobar/issues/119 -[github #127]: https://github.com/jaor/xmobar/issues/127 +[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 [github #109] and + `BatteryP`) accept now template variables (see [codeberg #109] and [#110]). Thanks to Todd Lunter. - New battery monitor extra argument, `-i`, for the idle status. @@ -546,8 +667,8 @@ _Bug fixes_ - Safer standard input parsing, avoiding injections. -[github #109]: https://github.com/jaor/xmobar/issues/109 -[#110]: https://github.com/jaor/xmobar/issues/110 +[codeberg #109]: https://codeberg.org/xmobar/xmobar/issues/109 +[#110]: https://codeberg.org/xmobar/xmobar/issues/110 ## Version 0.17 (May 5, 2013) @@ -561,19 +682,19 @@ _New features_ - 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 [github #105]. - - Experimental `-d` (start as a dock) option, may address [github #67] + 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 [github #77]. + - Partial (as reports go) fix for [codeberg #77]. - Safer volume plugin (Dmitry Malikov). - Battery percentage capped at 100% (RJ Regenold). -[github #67]: https://github.com/jaor/xmobar/issues/67 -[github #77]: https://github.com/jaor/xmobar/issues/77 -[github #105]: https://github.com/jaor/xmobar/issues/105 +[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) @@ -602,7 +723,7 @@ _Bug fixes_ - `DiskIO` now can report overall activity in all partitions of a device which is not mounted itself (e.g., sda when sda1, sda3, etc. are - the mounted partitions). Thanks to John Soros. See [github #73]. + 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. @@ -611,18 +732,18 @@ _Bug fixes_ server doesn't know how to get rid of (even when told so!). We're caching them now and X server memory doesn't grow. - Compilation errors and warnings with GHC 7.6 removed (thanks to - Raghavendra D Prabhu for his reports in [github #71]). + 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 [github #78] and pointers therein. Please, send +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! -[github #71]: https://github.com/jaor/xmobar/issues/71 -[github #73]: https://github.com/jaor/xmobar/issues/73 -[github #78]: https://github.com/jaor/xmobar/issues/78 +[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) @@ -641,7 +762,7 @@ _New features_ 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 - [github #36]). + [codeberg #36]). _Bug fixes_ @@ -653,15 +774,15 @@ _Bug fixes_ - 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 ([github #38]). + - 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 -[github #36]: https://github.com/jaor/xmobar/issues/36 -[github #38]: https://github.com/jaor/xmobar/issues/38 +[codeberg #36]: https://codeberg.org/xmobar/xmobar/issues/36 +[codeberg #38]: https://codeberg.org/xmobar/xmobar/issues/38 ## Version 0.14 (Dec 10, 2011) @@ -764,7 +885,7 @@ 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://github.com/jaor/xmobar +[source code repository]: https://codeberg.org/xmobar/xmobar [maintainer]: http://hacks-galore.org/jao/ _New features_ diff -pruN 0.36-2/debian/changelog 0.46-1/debian/changelog --- 0.36-2/debian/changelog 2020-10-29 09:20:33.000000000 +0000 +++ 0.46-1/debian/changelog 2023-01-09 15:14:51.000000000 +0000 @@ -1,3 +1,26 @@ +xmobar (0.46-1) unstable; urgency=medium + + * New upstream release + * B-D on libghc-pango-dev and libghc-cairo-dev; as of 0.45, xmobar uses + pango/cairo for font rendering instead of plain X11/Xft. + + -- Apollon Oikonomopoulos Mon, 09 Jan 2023 17:14:51 +0200 + +xmobar (0.44.2-1) unstable; urgency=medium + + * New upstream release + + -- Ilias Tsitsimpis Sun, 23 Oct 2022 18:28:01 +0300 + +xmobar (0.43-1) unstable; urgency=medium + + * New upstream release (Closes: #985305) + * Declare compliance with Debian policy 4.6.1 + * Update homepage (Closes: #986391) + * Build package using haskell-devscripts + + -- Ilias Tsitsimpis Wed, 03 Aug 2022 09:27:10 +0300 + xmobar (0.36-2) unstable; urgency=medium * Move maintenance under DHG diff -pruN 0.36-2/debian/compat 0.46-1/debian/compat --- 0.36-2/debian/compat 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/debian/compat 2022-11-11 07:38:43.000000000 +0000 @@ -0,0 +1 @@ +10 diff -pruN 0.36-2/debian/control 0.46-1/debian/control --- 0.36-2/debian/control 2020-10-29 09:18:09.000000000 +0000 +++ 0.46-1/debian/control 2023-01-09 15:14:51.000000000 +0000 @@ -1,38 +1,56 @@ Source: xmobar -Section: x11 -Priority: optional Maintainer: Debian Haskell Group -Uploaders: Apollon Oikonomopoulos , - Aggelos Avgerinos , -Standards-Version: 4.5.0 -Build-Depends: debhelper-compat (=12), - ghc, - libghc-alsa-core-dev (>= 0.5), - libghc-alsa-mixer-dev (>= 0.3), - libghc-dbus-dev [linux-any], - libghc-extensible-exceptions-dev, - libghc-hinotify-dev [linux-any], - libghc-http-conduit-dev, - libghc-http-dev (>= 1:4000), - libghc-iwlib-dev (>= 0.1.0) [linux-any], - libghc-mtl-dev, - libghc-parsec-numbers-dev, - libghc-parsec3-dev, - libghc-regex-compat-dev, - libghc-stm-dev (>= 2.3), - libghc-x11-dev (>= 1.6.0), - libghc-x11-xft-dev (>= 0.2), - libiw-dev [linux-any], - libxpm-dev, +Uploaders: + Apollon Oikonomopoulos , + Aggelos Avgerinos , +Priority: optional +Section: x11 +Build-Depends: debhelper (>= 10), + haskell-devscripts-minimal | haskell-devscripts (>= 0.13), + cdbs, + ghc, + libghc-x11-dev (>= 1.6.1), + libghc-aeson-dev (>= 1.4.7.1), + libghc-async-dev, + libghc-cairo-dev, + libghc-pango-dev, + libghc-extensible-exceptions-dev (>= 0.1), + libghc-extensible-exceptions-dev (<< 0.2), + libghc-http-client-tls-dev, + libghc-http-conduit-dev, + libghc-http-types-dev, + libghc-old-locale-dev, + libghc-parsec-numbers-dev (>= 0.1.0), + libghc-regex-compat-dev, + libghc-utf8-string-dev (>= 0.3), + libghc-utf8-string-dev (<< 1.1), + libxrandr-dev, + libxrender-dev, + libghc-hspec-dev (>= 2), + libghc-hspec-dev (<< 3), + libghc-temporary-dev, + libghc-alsa-core-dev (>= 0.5), + libghc-alsa-mixer-dev (>= 0.3), + libghc-x11-xft-dev (>= 0.2), + libghc-dbus-dev [linux-any], + libghc-hinotify-dev [linux-any], + libghc-iwlib-dev (>= 0.1.0) [linux-any], + libiw-dev [linux-any], + libxpm-dev, +Standards-Version: 4.6.1 +Homepage: https://codeberg.org/xmobar/xmobar Vcs-Browser: https://salsa.debian.org/haskell-team/DHG_packages/tree/master/p/xmobar -Vcs-Git: https://salsa.debian.org/haskell-team/DHG_packages.git [p/xmobar] -Homepage: http://projects.haskell.org/xmobar/ +Vcs-Git: https://salsa.debian.org/haskell-team/DHG_packages.git Package: xmobar Architecture: any -Depends: ${misc:Depends}, - ${shlibs:Depends}, -Suggests: xmonad, +Depends: ${haskell:Depends}, + ${misc:Depends}, + ${shlibs:Depends}, +Recommends: ${haskell:Recommends}, +Suggests: ${haskell:Suggests}, xmonad, +Conflicts: ${haskell:Conflicts}, +Provides: ${haskell:Provides}, Description: lightweight status bar for X11 window managers xmobar is a lightweight text-based status bar for X11 desktops written in Haskell and designed to work with (but not limited to) xmonad. It has a diff -pruN 0.36-2/debian/patches/0001-Fix-typo-in-src-Parsers.hs-fix-lintian-warning.patch 0.46-1/debian/patches/0001-Fix-typo-in-src-Parsers.hs-fix-lintian-warning.patch --- 0.36-2/debian/patches/0001-Fix-typo-in-src-Parsers.hs-fix-lintian-warning.patch 2020-10-29 09:07:53.000000000 +0000 +++ 0.46-1/debian/patches/0001-Fix-typo-in-src-Parsers.hs-fix-lintian-warning.patch 2023-01-09 15:14:51.000000000 +0000 @@ -8,7 +8,7 @@ Subject: Fix typo in src/Parsers.hs (fix --- a/src/Xmobar/Config/Parse.hs +++ b/src/Xmobar/Config/Parse.hs -@@ -167,7 +167,7 @@ +@@ -179,7 +179,7 @@ commandsErr :: String commandsErr = "commands: this usually means that a command could not" ++ "\nbe parsed." ++ diff -pruN 0.36-2/debian/rules 0.46-1/debian/rules --- 0.36-2/debian/rules 2020-10-29 09:18:21.000000000 +0000 +++ 0.46-1/debian/rules 2022-11-11 07:38:43.000000000 +0000 @@ -1,41 +1,20 @@ #!/usr/bin/make -f -# Uncomment this to turn on verbose mode. -#export DH_VERBOSE=1 -include /usr/share/dpkg/architecture.mk - -GHC_OPTIONS = -optl -Wl,-z,relro -optl -Wl,-z,now -optl -Wl,--as-needed +DEB_ENABLE_TESTS = yes # Work-around a bug in GHC on 64-bit unregistered platforms. # https://ghc.haskell.org/trac/ghc/ticket/15853 ifneq (,$(filter $(DEB_BUILD_ARCH),mips64el s390x alpha ia64 riscv64 sparc64)) - GHC_OPTIONS += -O0 + DEB_SETUP_GHC_CONFIGURE_ARGS += --ghc-options="-O0" endif -CONFIGURE_OPTS = --ghc-options="$(GHC_OPTIONS)" - ifeq ($(DEB_HOST_ARCH_OS),linux) - CONFIGURE_OPTS += --flags="with_xft with_inotify with_iwlib with_mpris with_dbus with_xpm with_uvmeter with_weather with_alsa" + DEB_SETUP_GHC_CONFIGURE_ARGS += --flags="with_xft with_inotify with_iwlib with_mpris with_dbus with_xpm with_uvmeter with_weather with_alsa" else - CONFIGURE_OPTS += --flags="with_xft with_xpm" + DEB_SETUP_GHC_CONFIGURE_ARGS += --flags="with_xft with_xpm" endif -%: - dh $@ - -override_dh_auto_configure: - ghc --make setup.*hs -o setup-ghc - ./setup-ghc configure --ghc --prefix=/usr $(CONFIGURE_OPTS) - -override_dh_auto_build: - ./setup-ghc build - -override_dh_auto_install: - ./setup-ghc copy --destdir=debian/tmp/ - -override_dh_auto_clean: - -./setup-ghc clean - -rm -f Setup.o Setup.hi setup-ghc +include /usr/share/cdbs/1/rules/debhelper.mk +include /usr/share/cdbs/1/class/hlibrary.mk -.PHONY: override_dh_auto_configure override_dh_auto_build \ - override_dh_auto_install override_dh_auto_clean +build/xmobar:: build-ghc-stamp check-ghc-stamp diff -pruN 0.36-2/debian/watch 0.46-1/debian/watch --- 0.36-2/debian/watch 2020-10-29 09:07:53.000000000 +0000 +++ 0.46-1/debian/watch 2022-11-11 07:38:43.000000000 +0000 @@ -1,3 +1,2 @@ -version=3 - -https://github.com/jaor/xmobar/tags .*/archive/([\d.]+)\.tar\.gz +version=4 +https://hackage.haskell.org/package/xmobar/distro-monitor .*-([0-9\.]+)\.(?:zip|tgz|tbz|txz|(?:tar\.(?:gz|bz2|xz))) diff -pruN 0.36-2/debian/xmobar.1 0.46-1/debian/xmobar.1 --- 0.36-2/debian/xmobar.1 2020-10-29 09:07:53.000000000 +0000 +++ 0.46-1/debian/xmobar.1 2022-11-11 07:38:43.000000000 +0000 @@ -83,7 +83,7 @@ This is the list of command line options \f[] .SH CONFIGURATION -For full details of the available configuration options, please refer to /usr/share/doc/xmobar/readme.md.gz. +For full details of the available configuration options, please refer to /usr/share/doc/xmobar/readme.org.gz. .SH AUTHOR .PP diff -pruN 0.36-2/debian/xmobar.docs 0.46-1/debian/xmobar.docs --- 0.36-2/debian/xmobar.docs 2020-10-29 09:07:53.000000000 +0000 +++ 0.46-1/debian/xmobar.docs 2022-11-11 07:38:43.000000000 +0000 @@ -1,2 +1,2 @@ changelog.md -readme.md +readme.org diff -pruN 0.36-2/debian/xmobar.examples 0.46-1/debian/xmobar.examples --- 0.36-2/debian/xmobar.examples 2020-10-29 09:07:53.000000000 +0000 +++ 0.46-1/debian/xmobar.examples 2022-11-11 07:38:43.000000000 +0000 @@ -1,2 +1,2 @@ -examples/xmobar.config -examples/xmonadpropwrite.hs +etc/xmobar.config +etc/xmonadpropwrite.hs diff -pruN 0.36-2/debian/xmobar.install 0.46-1/debian/xmobar.install --- 0.36-2/debian/xmobar.install 2020-10-29 09:07:53.000000000 +0000 +++ 0.46-1/debian/xmobar.install 2022-11-11 07:38:43.000000000 +0000 @@ -1 +1 @@ -usr/bin/xmobar +dist-ghc/build/xmobar/xmobar usr/bin diff -pruN 0.36-2/default.nix 0.46-1/default.nix --- 0.36-2/default.nix 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/default.nix 1970-01-01 00:00:00.000000000 +0000 @@ -1,43 +0,0 @@ -{ mkDerivation, alsa-core, alsa-mixer, async, base, bytestring -, containers, dbus, directory, extensible-exceptions, filepath -, hinotify, hspec, http-conduit, http-types, iwlib, libmpd, libXpm -, libXrandr, libXrender, mtl, old-locale, parsec, parsec-numbers -, process, regex-compat, stdenv, stm, temporary, time -, timezone-olson, timezone-series, transformers, unix, utf8-string -, wirelesstools, X11, X11-xft -}: -mkDerivation { - pname = "xmobar"; - version = "0.29.5"; - src = ./.; - configureFlags = [ - "-fwith_alsa" "-fwith_conduit" "-fwith_datezone" "-fwith_dbus" - "-fwith_inotify" "-fwith_iwlib" "-fwith_mpd" "-fwith_mpris" - "-fwith_rtsopts" "-fwith_threaded" "-fwith_utf8" "-fwith_uvmeter" - "-fwith_weather" "-fwith_xft" "-fwith_xpm" - ]; - isLibrary = true; - isExecutable = true; - libraryHaskellDepends = [ - alsa-core alsa-mixer async base bytestring containers dbus - directory extensible-exceptions filepath hinotify http-conduit - http-types iwlib libmpd mtl old-locale parsec parsec-numbers - process regex-compat stm time timezone-olson timezone-series - transformers unix utf8-string X11 X11-xft - ]; - librarySystemDepends = [ - libXpm libXrandr libXrender wirelesstools - ]; - executableHaskellDepends = [ - async base containers directory filepath parsec unix X11 - ]; - testHaskellDepends = [ - alsa-core alsa-mixer async base bytestring containers directory - filepath hspec mtl old-locale parsec parsec-numbers process - regex-compat stm temporary time transformers unix X11 - ]; - doCheck = false; - homepage = "http://xmobar.org"; - description = "A Minimalistic Text Based Status Bar"; - license = stdenv.lib.licenses.bsd3; -} diff -pruN 0.36-2/doc/compiling.org 0.46-1/doc/compiling.org --- 0.36-2/doc/compiling.org 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/doc/compiling.org 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,136 @@ +#+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=. diff -pruN 0.36-2/doc/plugins.org 0.46-1/doc/plugins.org --- 0.36-2/doc/plugins.org 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/doc/plugins.org 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,1597 @@ +#+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. diff -pruN 0.36-2/doc/quick-start.org 0.46-1/doc/quick-start.org --- 0.36-2/doc/quick-start.org 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/doc/quick-start.org 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,737 @@ +#+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 diff -pruN 0.36-2/doc/using-haskell.org 0.46-1/doc/using-haskell.org --- 0.36-2/doc/using-haskell.org 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/doc/using-haskell.org 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,130 @@ +#+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]]. diff -pruN 0.36-2/doc/web/makefile 0.46-1/doc/web/makefile --- 0.36-2/doc/web/makefile 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/doc/web/makefile 1970-01-01 00:00:00.000000000 +0000 @@ -1,35 +0,0 @@ -index.src = ../../readme.md -index = readme.md -releases = ../../changelog.md -css = xmobar.css -images = ../xmobar-sawfish.png ../xmobar-xmonad.png -remote = root@xmobar.org:/var/www/xmobar.org/ -htmls = index.html releases.html -title = % xmobar - a minimalistic status bar - -default: index.html - -$(index): $(index.src) - @tail -n+3 $(index.src) | sed "1s/^/$(title)\n/" > $(index) - -index.html: releases.html $(index) $(css) - pandoc -f markdown -t html -c $(css) --toc -N -s \ - $(index) > index.html - -releases.html: $(releases) $(css) - pandoc -f markdown -t html -c $(css) -s \ - $(releases) > releases.html - -imgs: - cp $(images) . - -upload-images: imgs - rsync -zav $(images) $(remote) - -upload-pages: $(htmls) - scp $(htmls) $(css) $(remote) - -upload: upload-images upload-pages - -clean: - rm -f $(htmls) $(index) *.png diff -pruN 0.36-2/doc/web/xmobar.css 0.46-1/doc/web/xmobar.css --- 0.36-2/doc/web/xmobar.css 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/doc/web/xmobar.css 1970-01-01 00:00:00.000000000 +0000 @@ -1,88 +0,0 @@ -body { - margin: auto; - padding-right: 1em; - padding-left: 1em; - max-width: 75%; - border-left: 1px solid black; - border-right: 1px solid black; - color: black; - font-family: Verdana, sans-serif; - font-size: 100%; - line-height: 140%; - color: #333; -} -pre { - border: 1px dotted gray; - background-color: #fafafa; - color: #111111; - padding: 0.5em; -} -code { - font-family: monospace; - font-size: 110%; -} -h1 a, h2 a, h3 a, h4 a, h5 a { - text-decoration: none; - color: #009900; -} -h1, h2, h3, h4, h5 { font-family: verdana; - font-weight: bold; - color: #000000; } -h1 { - font-size: 130%; -} - -h2 { - font-size: 110%; - border-bottom: 1px dotted black; -} - -h3 { - font-size: 95%; -} - -h4 { - font-size: 90%; - font-style: italic; -} - -h5 { - font-size: 90%; - font-style: italic; -} - -h1.title { - font-size: 150%; - font-weight: bold; - text-align: left; - border: none; -} - -dt code { - font-weight: bold; -} -dd p { - margin-top: 0; -} - -a:link { - color: #000036 -} - -a:visited { - color: #000000 -} -a:hover { - color: #000046 -} -a:active { - color: #000046 -} - -#footer { - padding-top: 1em; - font-size: 70%; - color: gray; - text-align: center; -} - Binary files 0.36-2/doc/xmobar-sawfish.png and 0.46-1/doc/xmobar-sawfish.png differ Binary files 0.36-2/doc/xmobar-xmonad.png and 0.46-1/doc/xmobar-xmonad.png differ diff -pruN 0.36-2/etc/padding-icon.sh 0.46-1/etc/padding-icon.sh --- 0.36-2/etc/padding-icon.sh 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/etc/padding-icon.sh 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,56 @@ +#!/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}/>" diff -pruN 0.36-2/etc/xmobar.config 0.46-1/etc/xmobar.config --- 0.36-2/etc/xmobar.config 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/etc/xmobar.config 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,39 @@ +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%" + } diff -pruN 0.36-2/etc/xmobar.el 0.46-1/etc/xmobar.el --- 0.36-2/etc/xmobar.el 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/etc/xmobar.el 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,167 @@ +;; 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 diff -pruN 0.36-2/etc/xmobar.hs 0.46-1/etc/xmobar.hs --- 0.36-2/etc/xmobar.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/etc/xmobar.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,77 @@ +------------------------------------------------------------------------------ +-- | +-- 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 diff -pruN 0.36-2/etc/xmonadpropwrite.hs 0.46-1/etc/xmonadpropwrite.hs --- 0.36-2/etc/xmonadpropwrite.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/etc/xmonadpropwrite.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,41 @@ +-- Copyright Spencer Janssen <spencerjanssen@gmail.com> +-- Tomas Janousek <tomi@nomi.cz> +-- BSD3 (see LICENSE) +-- +-- Reads from standard input and writes to an X propery on root window. +-- To be used with XPropertyLog: +-- Add it to commands: +-- Run XPropertyLog "_XMONAD_LOG_CUSTOM" +-- Add it to the template: +-- template = "... %_XMONAD_LOG_CUSTOM% ..." +-- Run: +-- $ blah blah | xmonadpropwrite _XMONAD_LOG_CUSTOM + +import Control.Monad +import Graphics.X11 +import Graphics.X11.Xlib.Extras +import qualified Data.ByteString as B +import Foreign.C (CChar) +import System.IO +import System.Environment + +main = do + atom <- flip fmap getArgs $ \args -> case args of + [a] -> a + _ -> "_XMONAD_LOG" + + d <- openDisplay "" + xlog <- internAtom d atom False + ustring <- internAtom d "UTF8_STRING" False + + root <- rootWindow d (defaultScreen d) + + forever $ do + msg <- B.getLine + changeProperty8 d root xlog ustring propModeReplace (encodeCChar msg) + sync d True + + return () + +encodeCChar :: B.ByteString -> [CChar] +encodeCChar = map fromIntegral . B.unpack diff -pruN 0.36-2/examples/build 0.46-1/examples/build --- 0.36-2/examples/build 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/examples/build 1970-01-01 00:00:00.000000000 +0000 @@ -1,17 +0,0 @@ -#!/usr/bin/bash - -# An example build script that directs ghc to use a temporary directory for its -# intermediate files instead of writing them into XMOBAR_CONFIG_DIR. This -# allows using a read-only XMOBAR_CONFIG_DIR. To use this script, place it in -# XMOBAR_CONFIG_DIR and call it "build". - -bin=$1 -object_dir=$(mktemp -d) - -default_build_args=(--make xmobar.hs -i -ilib -fforce-recomp -main-is main -v0 -o "$bin" -threaded -rtsopts -with-rtsopts -V0) # From src/Xmobar/App/Compile.hs -extra_build_args=(-odir "$object_dir" -hidir "$object_dir") - -ghc "${default_build_args[@]}" "${extra_build_args[@]}" -status=$? -rm -r "$object_dir" -exit $status diff -pruN 0.36-2/examples/padding-icon.sh 0.46-1/examples/padding-icon.sh --- 0.36-2/examples/padding-icon.sh 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/examples/padding-icon.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,56 +0,0 @@ -#!/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://github.com/jaor/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}/>" diff -pruN 0.36-2/examples/status.sh 0.46-1/examples/status.sh --- 0.36-2/examples/status.sh 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/examples/status.sh 1970-01-01 00:00:00.000000000 +0000 @@ -1,54 +0,0 @@ -#!/bin/bash - -STATUSPIPE="/tmp/xmobar_status_jrk" - -function isMuted () { - # retrieve mute status - # return an arbitrary string for true or nothing at all - echo -} - -function getPercent () { - # somehow retrieve the percent value as plain int (e.g. "66") - echo "66" -} - -function percentBar () { - local i=1 res= - normal=47 high=80 - fgColor='#657b83' mutedColor='#cb4b16' - lowColor='#859900' midColor='#b58900' - highColor='#cb4b16' - - bar="$(echo -ne "\u2588")" - percent="$( getPercent )" - muted="$( isMuted )" - - if [ -n "$muted" ]; then - res="<fc=$mutedColor>" - else - res="<fc=$lowColor>" - fi - - while [ $i -lt $percent ]; do - if [ $i -eq $normal -a -z "$muted" ]; then - res+="</fc><fc=$midColor>" - elif [ $i -eq $high -a -z "$muted" ]; then - res+="</fc><fc=$highColor>" - fi - - res+=$bar - i=$((i+1)) - done - - res+="</fc><fc=$fgColor>" - - while [ $i -lt 100 ]; do - res+='-' - i=$((i+1)) - done - - echo "$res</fc>" -} - -echo "$( percentBar )" > "$STATUSPIPE" diff -pruN 0.36-2/examples/xmobar.config 0.46-1/examples/xmobar.config --- 0.36-2/examples/xmobar.config 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/examples/xmobar.config 1970-01-01 00:00:00.000000000 +0000 @@ -1,38 +0,0 @@ -Config { font = "-misc-fixed-*-*-*-*-10-*-*-*-*-*-*-*" - , 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 - , 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% | %memory% * %swap% | %eth0% - %eth1% }\ - \{ <fc=#ee9a00>%date%</fc>| %EGPF% | %uname%" - } diff -pruN 0.36-2/examples/xmobar.hs 0.46-1/examples/xmobar.hs --- 0.36-2/examples/xmobar.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/examples/xmobar.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,76 +0,0 @@ ------------------------------------------------------------------------------- --- | --- Copyright: (c) 2018, 2019 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 - , 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 = xmobar config diff -pruN 0.36-2/examples/xmonadpropwrite.hs 0.46-1/examples/xmonadpropwrite.hs --- 0.36-2/examples/xmonadpropwrite.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/examples/xmonadpropwrite.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,41 +0,0 @@ --- 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 diff -pruN 0.36-2/.github/workflows/haskell.yml 0.46-1/.github/workflows/haskell.yml --- 0.36-2/.github/workflows/haskell.yml 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/.github/workflows/haskell.yml 1970-01-01 00:00:00.000000000 +0000 @@ -1,57 +0,0 @@ -name: Haskell CI (PRs) - -on: - pull_request: - branches: [ master ] - workflow_dispatch: - -jobs: - build: - - runs-on: ubuntu-latest - strategy: - matrix: - cabal: ["3.2"] - ghc: ["8.4", "8.6", "8.8.3", "8.10"] - env: - CONFIG: "--enable-tests --enable-benchmarks -fall_extensions" - - steps: - - uses: actions/checkout@v2 - - uses: actions/setup-haskell@v1 - with: - ghc-version: ${{ matrix.ghc }} - cabal-version: ${{ matrix.cabal }} - - - name: Cache - uses: actions/cache@v1 - env: - cache-name: cache-cabal - with: - path: ~/.cabal - key: ${{ runner.os }}-build-${{ env.cache-name }}-${{ hashFiles('**/*.cabal') }}-${{ hashFiles('**/cabal.project') }} - restore-keys: | - ${{ runner.os }}-build-${{ env.cache-name }}- - ${{ runner.os }}-build- - ${{ runner.os }}- - - - name: Install packages - run: | - sudo apt-get install -y xorg-dev - sudo apt-get install -y libasound2-dev libxpm-dev libmpd-dev libxrandr-dev - sudo apt-get install -y happy c2hs hspec-discover - - - name: Install dependencies - run: | - cabal update - cabal build --dependencies-only $CONFIG - - - name: Build - run: cabal build $CONFIG - - - name: Run hlint - run: | - wget https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh - sh ./travis.sh src - - name: Run tests - run: cabal test diff -pruN 0.36-2/.gitignore 0.46-1/.gitignore --- 0.36-2/.gitignore 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/.gitignore 1970-01-01 00:00:00.000000000 +0000 @@ -1,22 +0,0 @@ -/dist/ -/dist-newstyle/ -/TAGS -/doc/web/index.html -/doc/web/releases.html -/cabal-dev/ -.cabal-sandbox -cabal.sandbox.config -.stack-work -/doc/web/readme.md -/.idea/ -/xmobar.iml -/out/ -/cabal.config -codex.tags -cabal.project.localtags -*.swp -tags -/cabal.project.local -/.ghc.environment.* -/cabal.project.local~ -/stack.yaml.lock diff -pruN 0.36-2/.hlint.yaml 0.46-1/.hlint.yaml --- 0.36-2/.hlint.yaml 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/.hlint.yaml 1970-01-01 00:00:00.000000000 +0000 @@ -1,68 +0,0 @@ -# HLint configuration file -# https://github.com/ndmitchell/hlint -########################## - -# This file contains a template configuration file, which is typically -# placed as .hlint.yaml in the root of your project - - -# Warnings currently triggered by your code -- ignore: {name: "Use module export list"} -- ignore: {name: "Redundant True guards"} -- ignore: {name: "Use <$>"} -- ignore: {name: "Use uncurry"} -- ignore: {name: "Reduce duplication"} -- ignore: {name: "Use sortOn"} - -# Specify additional command line arguments -# -# - arguments: [--color, --cpp-simple, -XQuasiQuotes] - - -# Control which extensions/flags/modules/functions can be used -# -# - extensions: -# - default: false # all extension are banned by default -# - name: [PatternGuards, ViewPatterns] # only these listed extensions can be used -# - {name: CPP, within: CrossPlatform} # CPP can only be used in a given module -# -# - flags: -# - {name: -w, within: []} # -w is allowed nowhere -# -# - modules: -# - {name: [Data.Set, Data.HashSet], as: Set} # if you import Data.Set qualified, it must be as 'Set' -# - {name: Control.Arrow, within: []} # Certain modules are banned entirely -# -# - functions: -# - {name: unsafePerformIO, within: []} # unsafePerformIO can only appear in no modules - - -# Add custom hints for this project -# -# Will suggest replacing "wibbleMany [myvar]" with "wibbleOne myvar" -# - error: {lhs: "wibbleMany [x]", rhs: wibbleOne x} - - -# Turn on hints that are off by default -# -# Ban "module X(module X) where", to require a real export list -# - warn: {name: Use explicit module export list} -# -# Replace a $ b $ c with a . b $ c -# - group: {name: dollar, enabled: true} -# -# Generalise map to fmap, ++ to <> -# - group: {name: generalise, enabled: true} - - -# Ignore some builtin hints -# - ignore: {name: Use let} -# - ignore: {name: Use const, within: SpecialModule} # Only within certain modules - - -# Define some custom infix operators -# - fixity: infixr 3 ~^#^~ - - -# To generate a suitable file for HLint do: -# $ hlint --default > .hlint.yaml diff -pruN 0.36-2/readme.md 0.46-1/readme.md --- 0.36-2/readme.md 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/readme.md 1970-01-01 00:00:00.000000000 +0000 @@ -1,1914 +0,0 @@ -[![Hackage](https://img.shields.io/hackage/v/xmobar.svg)](http://hackage.haskell.org/package/xmobar) - -<!-- markdown-toc start - Don't edit this section. Run M-x markdown-toc-refresh-toc --> -**Table of Contents** - -- [About](#about) -- [Bug reports](#bug-reports) -- [Installation](#installation) - - [Using cabal-install](#using-cabal-install) - - [From source](#from-source) - - [Optional features](#optional-features) -- [Running xmobar](#running-xmobar) - - [Signal Handling](#signal-handling) -- [Configuration](#configuration) - - [Quick Start](#quick-start) - - [Running xmobar with i3status](#running-xmobar-with-i3status) - - [Dynamically sizing xmobar](#dynamically-sizing-xmobar) - - [Command Line Options](#command-line-options) - - [The Output Template](#the-output-template) - - [The `commands` Configuration Option](#the-commands-configuration-option) -- [System Monitor Plugins](#system-monitor-plugins) - - [Icon patterns](#icon-patterns) - - [Default Monitor Arguments](#default-monitor-arguments) - - [`Uptime Args RefreshRate`](#uptime-args-refreshrate) - - [`Weather StationID Args RefreshRate`](#weather-stationid-args-refreshrate) - - [`WeatherX StationID SkyConditions Args RefreshRate`](#weatherx-stationid-skyconditions-args-refreshrate) - - [`Network Interface Args RefreshRate`](#network-interface-args-refreshrate) - - [`DynNetwork Args RefreshRate`](#dynnetwork-args-refreshrate) - - [`Wireless Interface Args RefreshRate`](#wireless-interface-args-refreshrate) - - [`Memory Args RefreshRate`](#memory-args-refreshrate) - - [`Swap Args RefreshRate`](#swap-args-refreshrate) - - [`Cpu Args RefreshRate`](#cpu-args-refreshrate) - - [`MultiCpu Args RefreshRate`](#multicpu-args-refreshrate) - - [`Battery Args RefreshRate`](#battery-args-refreshrate) - - [`BatteryP Dirs Args RefreshRate`](#batteryp-dirs-args-refreshrate) - - [`BatteryN Dirs Args RefreshRate Alias`](#batteryn-dirs-args-refreshrate-alias) - - [`TopProc Args RefreshRate`](#topproc-args-refreshrate) - - [`TopMem Args RefreshRate`](#topmem-args-refreshrate) - - [`DiskU Disks Args RefreshRate`](#disku-disks-args-refreshrate) - - [`DiskIO Disks Args RefreshRate`](#diskio-disks-args-refreshrate) - - [`ThermalZone Number Args RefreshRate`](#thermalzone-number-args-refreshrate) - - [`Thermal Zone Args RefreshRate`](#thermal-zone-args-refreshrate) - - [`CpuFreq Args RefreshRate`](#cpufreq-args-refreshrate) - - [`CoreTemp Args RefreshRate`](#coretemp-args-refreshrate) - - [`MultiCoreTemp Args RefreshRate`](#multicoretemp-args-refreshrate) - - [`Volume Mixer Element Args RefreshRate`](#volume-mixer-element-args-refreshrate) - - [`Alsa Mixer Element Args`](#alsa-mixer-element-args) - - [`MPD Args RefreshRate`](#mpd-args-refreshrate) - - [`Mpris1 PlayerName Args RefreshRate`](#mpris1-playername-args-refreshrate) - - [`Mpris2 PlayerName Args RefreshRate`](#mpris2-playername-args-refreshrate) - - [`Mail Args Alias`](#mail-args-alias) - - [`MailX Args Opts Alias`](#mailx-args-opts-alias) - - [`MBox Mboxes Opts Alias`](#mbox-mboxes-opts-alias) - - [`XPropertyLog PropName`](#xpropertylog-propname) - - [`UnsafeXPropertyLog PropName`](#unsafexpropertylog-propname) - - [`NamedXPropertyLog PropName Alias`](#namedxpropertylog-propname-alias) - - [`UnsafeNamedXPropertyLog PropName Alias`](#unsafenamedxpropertylog-propname-alias) - - [`Brightness Args RefreshRate`](#brightness-args-refreshrate) - - [`Kbd Opts`](#kbd-opts) - - [`Locks`](#locks) - - [`CatInt n filename`](#catint-n-filename) - - [`UVMeter`](#uvmeter) -- [Executing External Commands](#executing-external-commands) -- [Other Plugins](#other-plugins) - - [`StdinReader`](#stdinreader) - - [`UnsafeStdinReader`](#unsafestdinreader) - - [`Date Format Alias RefreshRate`](#date-format-alias-refreshrate) - - [`DateZone Format Locale Zone Alias RefreshRate`](#datezone-format-locale-zone-alias-refreshrate) - - [`CommandReader "/path/to/program" Alias`](#commandreader-pathtoprogram-alias) - - [`PipeReader "default text:/path/to/pipe" Alias`](#pipereader-default-textpathtopipe-alias) - - [`MarqueePipeReader "default text:/path/to/pipe" (length, rate, sep) Alias`](#marqueepipereader-default-textpathtopipe-length-rate-sep-alias) - - [`BufferedPipeReader Alias [(Timeout, Bool, "/path/to/pipe1"), ..]`](#bufferedpipereader-alias-timeout-bool-pathtopipe1-) - - [`XMonadLog`](#xmonadlog) - - [`UnsafeXMonadLog`](#unsafexmonadlog) - - [`HandleReader Handle Alias`](#handlereader-handle-alias) -- [The DBus Interface](#the-dbus-interface) - - [Example for using the DBus IPC interface with XMonad](#example-for-using-the-dbus-ipc-interface-with-xmonad) -- [User plugins](#user-plugins) - - [Writing a Plugin](#writing-a-plugin) - - [Using a Plugin](#using-a-plugin) - - [Configurations written in pure Haskell](#configurations-written-in-pure-haskell) -- [Authors and credits](#authors-and-credits) - - [Thanks](#thanks) -- [Related](#related) -- [License](#license) - -<!-- markdown-toc end --> - -# About - -Xmobar is a minimalistic status bar. It was originally designed and -implemented by Andrea Rossato to work with [xmonad], but it is -actually usable with any window manager. - -Xmobar was inspired by the [Ion3] status bar, and supports similar -features, like dynamic color management, icons, output templates, and -extensibility through plugins. - -These are two xmobar instances using the author's configuration: - -![top](https://gitlab.com/jaor/xmobar-config/raw/master/img/xmobar-top.png) - -![bottom](https://gitlab.com/jaor/xmobar-config/raw/master/img/xmobar-bottom.png) - -and [this one](doc/xmobar-xmonad.png) is a full desktop with [xmonad] -and, again, two instances of xmobar. - -[xmonad]: http://xmonad.org -[Ion3]: http://tuomov.iki.fi/software/ - -# Bug reports - -To submit bug reports you can use the [bug tracker over at -Github](https://github.com/jaor/xmobar/issues). - -# Installation - -## Using cabal-install - -Xmobar is available from [Hackage], and you can install it using -`cabal-install`: - - cabal install xmobar - -Xmobar versions >= 0.27 require GHC version >= 8.0.2. Due to an -intermittent bug in GHC, we recommend using either GHC 8.0.2, 8.2.2 or -8.6. - -See below for a list of optional compilation flags that will enable -some optional plugins. For instance, to install xmobar with all the -bells and whistles, use: - - cabal install xmobar --flags="all_extensions" - -## From source - -If you don't have `cabal-install` installed, you can get xmobar's -source code in a variety of ways: - - - From [Hackage]. Just download the latest release from xmobar's - hackage page. - - From [Github]. You can also obtain a tarball in [Github's - downloads page]. You'll find there links to each tagged release. - - From the bleeding edge repo. If you prefer to live dangerously, - just get the latest and greatest (and buggiest, I guess) using - git: - - git clone git://github.com/jaor/xmobar - - -[Github's downloads page]: https://github.com/jaor/xmobar/downloads - -If you have cabal installed, you can now use it from within xmobar's -source tree: - - cabal install -fall_extensions - - -There is also a barebones `stack.yaml` file that will allow you to -build the xmobar executable with stances of the form: - - stack install --flag xmobar:all_extensions - - -## Optional features - -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, as shown in the examples above. - -Extensions need additional libraries (listed below) that will be -automatically downloaded and installed if you're using cabal install. -Otherwise, you'll need to install them yourself. - -- `with_dbus` Enables support for DBUS by making xmobar to publish a - service on the session bus. Requires the [dbus] package. - -- `with_threaded` Uses GHC's threaded runtime. Use this option if - xmobar enters a high-CPU regime right after starting. - -- `with_utf8` UTF-8 support. Requires the [utf8-string] package. - -- `with_xft` Antialiased fonts. Requires the [X11-xft] package. This - option automatically enables UTF-8. To use XFT fonts you need to - use the `xft:` prefix in the `font` configuration option. For - instance: - - font = "xft:Times New Roman-10:italic" - - Or to have fallback fonts, just separate them by commas: - - font = "xft:Open Sans:size=9,WenQuanYi Zen Hei:size=9" - -- `with_mpd` Enables support for the [MPD] daemon. Requires the - [libmpd] package. - -- `with_mpris` Enables support for MPRIS v1/v2 protocol. Requires the - [dbus] and [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 - [hinotify] package. - -- `with_nl80211` Support for wireless cards on Linux via nl80211 (all - upstream drivers). Enables the Wireless plugin. Requires [netlink] - and [cereal] packages. - -- `with_iwlib` Support for wireless cards via Wext ioctls - (deprecated). Enables the Wireless plugin. No Haskell library is - required, but you will need the [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`. - -- `with_alsa` Support for ALSA sound cards. Enables the Volume - plugin. Requires the [alsa-mixer] package. To install the latter, - you'll need the [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 [timezone-olson] and [timezone-series] package. - -- `with_xpm` Support for xpm image file format. This will allow loading - .xpm files in `<icon>`. Requires the [libXpm] C library. - -- `with_uvmeter` Enables UVMeter plugin. The plugin shows UV data for - Australia. - -- `with_weather` Support to display weather information. Enables - Weather plugin. - -- `all_extensions` Enables all the extensions above. - -# Running xmobar - -You can now run xmobar with: - - xmobar /path/to/config & - -or - - xmobar & - -if you have the default configuration file saved as -`$XDG\_CONFIG\_HOME/xmobar/xmobarrc` (defaulting to -`~/.config/xmobar/xmobarrc`), or `~/.xmobarrc`. - -## Signal Handling - -Since 0.14 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. - -# Configuration - -## Quick Start - -See [examples/xmobar.config] for an example. - -[examples/xmobar.config]: http://github.com/jaor/xmobar/raw/master/examples/xmobar.config - -For the output template: - -- `%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 XFT fonts. `<fc=#FF0000,#000000:0>string</fc>` will have a background - matching the bar's height. - -- `<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: - - <box type=Bottom width=2 color=red>string</box> - - and if you wanted an underline and an overline with a margin of 2 - pixels either side: - - <box type=VBoth mt=2 mb=2>string</box> - -- `<fn=1>string</fn>` will print `string` with the first font from - `additionalFonts`. The index `0` corresponds to the standard font. - -- `<icon=/path/to/icon.xbm/>` will insert the given bitmap. XPM image - format is also supported when compiled with `--flags="with_xpm"`. - -- ```<action=`command` button=12345>``` will execute given command - when clicked with specified buttons. If not specified, button is - equal to 1 (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 - - xmobar -c "[Run UnsafeStdinReader]" -t "%UnsafeStdinReader%" - - and receives on standard input the line - - <action=`echo test` button=1><raw=41:<action=`echo mooo` button=1>foo</action>/></action>` - - then it will display the text ```<action=`echo mooo` button=1>foo</action>```, - which, when clicked, will cause `test` to be echoed. - -Other configuration options: - -- `font` Name of the font to be used. Use the `xft:` prefix for XFT - fonts. - -- `additionalFonts` Haskell-style list of fonts to be used with the - `fn`-template. Use the `xft:` prefix for XFT fonts. See also - `textOffsets` below. - -- `bgColor` Background color. - -- `fgColor` Default font color. - -- `alpha` The transparency. 0 is transparent, 255 is opaque. - -- `position` Top, TopP, TopW, TopSize, Bottom, 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. - - For example: - - position = BottomW C 75 - - to place xmobar at the bottom, centered with the 75% of the screen - width. Or - - position = BottomP 120 0 - - to place xmobar at the bottom, with 120 pixel indent of the left. - Or - - position = Static { xpos = 0 , ypos = 0, width = 1024, height = 15 } - - or - - position = Top - -- `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. - -- `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. - -- `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 `iconRoot ++ "/"` prepended to it. Default is - `"."`. - -- `commands` For setting the options of the programs to run - (optional). - -- `sepChar` The character to be used for indicating commands in the - output template (default '%'). - -- `alignSep` a 2 character string for aligning text in the output - template. The text before the first character will be align to left, - the text in between the 2 characters will be centered, and the text - after the second character will be align to the right. - -- `template` The output template. - -- `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". - -### Running xmobar with i3status - -xmobar can be used to display information generated by [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 [i3status manual] for -further details. - -### Dynamically sizing xmobar - -See [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 [examples/padding-icon.sh](./examples/padding-icon.sh). - -[this idea]: https://github.com/jaor/xmobar/issues/239#issuecomment-233206552 - -## 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: - - xmobar -B white -a right -F blue -t '%LIPB%' -c '[Run Weather "LIPB" [] 36000]' - -This is the list of command line options (the output of -xmobar --help): - - Usage: xmobar [OPTION...] [FILE] - Options: - -h, -? --help This help - -V --version Show version information - -v --verbose Emit verbose debugging messages - -r --recompile Force recompilation (for Haskell FILE) - -f font name --font=font name Font name - -w class --wmclass=class X11 WM_CLASS property - -n name --wmname=name X11 WM_NAME property - -B bg color --bgcolor=bg color Background color. Default black - -F fg color --fgcolor=fg color Foreground color. Default grey - -A alpha --alpha=alpha Transparency: 0 is transparent - and 255 (the default) is opaque - -o --top Place xmobar at the top of the screen - -b --bottom Place xmobar at the bottom of the screen - -p --position=position Specify position, same as in config file - -d --dock Try to start xmobar 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 - -i path --iconroot=path Default directory for icon pattern files - -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 - - Mail bug reports and suggestions to <mail@jao.io> - - -## The Output Template - -The output template must contain at least one command. xmobar will -parse the template and will search for the command to be executed in -the `commands` configuration option. First an `alias` will be searched -(plugins such as Weather or Network have default aliases, see below). -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. - -It's possible to insert in the global templates icon directives of the -form: - - <icon=/path/to/bitmap.xbm/> - -which will produce the expected result. Accepted image formats are XBM -and XPM (when `with_xpm` flag is enabled). If path does not start with -`"/"`, `"./"`, `"../"` it will have `iconRoot ++ "/"` prepended to it. - -It's also possible to use action directives of the form: - - <action=`command` button=12345> - -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. - -## The `commands` Configuration Option - -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 option consists in a list of commands separated by a comma and -enclosed by square parenthesis. - -Example: - - [Run Memory ["-t","Mem: <usedratio>%"] 10, Run Swap [] 10] - -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: - - template="<icon=/home/jao/.xmobar/mem.xbm/><memory> <swap>" - -This example will run "xclock" command when date is clicked: - - template="<action=`xclock`>%date%</action> - -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. - -# 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 have default aliases. The sections below describe every -monitor in turn, but before we provide a list of the configuration -options (or *monitor arguments*) they all share. - -## 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. `"<icon=/path/to/icon_%%.xpm/>"` will be interpreted -as `"<icon=/path/to/icon_3.xpm/>"` when the value is `3`, also `"%"` is interpreted -as `"%"`, `"%%"` as `"3"`, `"%%%"` as `"3%"`, `"%%%%"` as `"33"` and so on). Essentially -it allows to replace vertical bars with custom icons. For example, - - Run Brightness - [ "-t", "<ipat>" - , "--" - , "--brightness-icon-pattern", "<icon=bright_%%.xpm/>" - ] 30 - -Will display `bright_0.xpm` to `bright_8.xpm` depending on current brightness -value. - -## Default Monitor Arguments - -Monitors accept a common set of arguments, described in the first -subsection below. In addition, some monitors accept additional options -that are specific to them. When specifying the list of arguments in -your configuration, the common options come first, followed by "--", -followed by any monitor-specific options. - -These are the options available for all monitors below: - -- `-t` _string_ Output template - - Template for the monitor output. Field names must be enclosed - between pointy brackets (`<foo>`) and will be substituted by the - computed values. You can also specify the foreground (and - optionally, background) color for a region by bracketing it - between `<fc=fgcolor>` (or `<fc=fgcolor,bgcolor>`) and - `</fc>`. The rest of the template is output verbatim. - - Long option: `--template` - - Default value: per monitor (see above). -- `-H` _number_ The high threshold. - - Numerical values higher than _number_ will be displayed with the - color specified by `-h` (see below). - - Long option: `--High` - - Default value: 66 -- `-L` _number_ The low threshold. - - Numerical values higher than _number_ and lower than the high - threshold will be displayed with the color specified by `-n` - (see below). Values lower than _number_ will use the `-l` color. - - Long option: `--Low` - - Default value: 33 -- `-h` _color_ High threshold color. - - Color for displaying values above the high threshold. _color_ can - be either a name (e.g. "blue") or an hexadecimal RGB (e.g. - "#FF0000"). - - Long option: `--high` - - Default: none (use the default foreground). -- `-n` _color_ Color for 'normal' values - - Color used for values greater than the low threshold but lower - than the high one. - - Long option: `--normal` - - Default: none (use the default foreground). -- `-l` _color_ The low threshold color - - Color for displaying values below the low threshold. - - Long option: `--low` - - Default: none (use the default foreground). -- `-S` _boolean_ Display optional suffixes - - When set to a true designator ("True", "Yes" or "On"), optional - value suffixes such as the '%' symbol or optional units will be - displayed. - - Long option: `--suffix` - - Default: False. -- `-p` _number_ Percentages padding - - Width, in number of digits, for quantities representing - percentages. For instance `-p 3` means that all percentages - in the monitor will be represented using 3 digits. - - Long option: `--ppad` - - Default value: 0 (don't pad) -- `-d` _number_ Decimal digits - - Number of digits after the decimal period to use in float values. - - Long option: `--ddigits` - - Default value: 0 (display only integer part) -- `-m` _number_ Minimum field width - - Minimum width, in number of characters, of the fields in the - monitor template. Values whose printed representation is shorter - than this value will be padded using the padding characters - given by the `-c` option with the alignment specified by `-a` - (see below). - - Long option: `--minwidth` - - Default: 0 -- `-M` _number_ Maximum field width - - Maximum width, in number of characters, of the fields in the - monitor template. Values whose printed representation is longer - than this value will be truncated. - - Long option: `--maxwidth` - - Default: 0 (no maximum width) -- `-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.: - - Run Weather "EGPF" ["-t", "<station>: <tempC>C"] 36000 - -In this case xmobar will run the weather monitor, getting information -for the weather station ID EGPF (Glasgow Airport, as a homage to GHC) -every hour (36000 tenth of seconds), with a template that will output -something like: - - Glasgow Airport: 16.0C - - -## `Uptime Args RefreshRate` - -- Aliases to `uptime` -- Args: default monitor arguments. 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` - -## `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. - -## `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: - -```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 -``` - -As mentioned, the replacement string can also be an icon -specification, such as `("clear", "<icon=weather-clear.xbm/>")`. - -## `Network Interface Args RefreshRate` - -- Aliases to the interface name: so `Network "eth0" []` can be used as - `%eth0%` -- Thresholds refer to velocities expressed in Kb/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 Kb/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 `--flags="with_nl80211"` or - `--flags="with_iwlib"` during compilation - -## `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`. -- 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: <usedratio>% (<cache>M)` - -## `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: <usedratio>%` - -## `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: <total>%` - -## `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: <total>%` - -## `Battery Args RefreshRate` - -- Same as `BatteryP ["BAT", "BAT0", "BAT1", "BAT2"] Args RefreshRate`. - -## `BatteryP Dirs Args RefreshRate` - -- 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: <watts>, <left>% / <timeleft>` -- Example (note that you need "--" to separate regular monitor options from - Battery's specific ones): - - Run BatteryP ["BAT0"] - ["-t", "<acstatus><watts> (<left>%)", - "-L", "10", "-H", "80", "-p", "3", - "--", "-O", "<fc=green>On</fc> - ", "-i", "", - "-L", "-15", "-H", "-5", - "-l", "red", "-m", "blue", "-h", "green" - "-a", "notify-send -u critical 'Battery running out!!'", - "-A", "3"] - 600 - - In the above example, the thresholds before the "--" separator - affect only the `<left>` and `<leftbar>` fields, while those after - the separator affect how `<watts>` is displayed. For this monitor, - neither the generic nor the specific options have any effect on - `<timeleft>`. 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: - - Run BatteryP ["BAT0"] - ["-t", "<acstatus>" - , "-L", "10", "-H", "80" - , "-l", "red", "-h", "green" - , "--", "-O", "Charging", "-o", "Battery: <left>%" - ] 10 - -- 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. - -## `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: `<both1>` -- 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: `<both1>` -- 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. - -## `DiskU Disks Args RefreshRate` - -- Aliases to `disku` -- Disks: list of pairs of the form (device or mount point, template), - where the template can contain `<size>`, `<free>`, `<used>`, `<freep>` or - `<usedp>`, `<freebar>`, `<freevbar>`, `<freeipat>`, `<usedbar>`, - `<usedvbar>` or `<usedipat>` 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: - - DiskU [("/", "<used>/<size>"), ("sdb1", "<usedbar>")] - ["-L", "20", "-H", "50", "-m", "1", "-p", "3"] - 20 - -## `DiskIO Disks Args RefreshRate` - -- Aliases to `diskio` -- Disks: list of pairs of the form (device or mount point, template), - where the template can contain `<total>`, `<read>`, `<write>` for - total, read and write speed, respectively, as well as `<totalb>`, - `<readb>`, `<writeb>`, which report number of bytes during the last - refresh period rather than speed. There are also bar versions of - each: `<totalbar>`, `<totalvbar>`, `<totalipat>`, `<readbar>`, - `<readvbar>`, `<readipat>`, `<writebar>`, `<writevbar>`, and - `<writeipat>`; and their "bytes" counterparts: `<totalbbar>`, - `<totalbvbar>`, `<totalbipat>`, `<readbbar>`, `<readbvbar>`, - `<readbipat>`, `<writebbar>`, `<writebvbar>`, and `<writebipat>`. -- 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 `<totalipat>`. - - `--write-icon-pattern`: dynamic string for write disk I/O in `<writeipat>`. - - `--read-icon-pattern`: dynamic string for read disk I/O in `<readipat>`. -- Default template: none (you must specify a template for each file system). -- Example: - - DiskIO [("/", "<read> <write>"), ("sdb1", "<total>")] [] 10 - -## `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: `<temp>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: - - Run ThermalZone 0 ["-t","<id>: <temp>C"] 30 - -## `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: <temp>C` -- This plugin works only on systems with devices having thermal zone. - Check directories in /proc/acpi/thermal_zone for possible values. -- Example: - - Run Thermal "THRM" ["-t","iwl4965-temp: <temp>C"] 50 - -## `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` -- Default template: `Freq: <cpu0>GHz` -- This monitor requires acpi_cpufreq module to be loaded in kernel -- Example: - - Run CpuFreq ["-t", "Freq:<cpu0>|<cpu1>GHz", "-L", "0", "-H", "2", - "-l", "lightblue", "-n","white", "-h", "red"] 50 - -## `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: <core0>C` -- This monitor requires coretemp module to be loaded in kernel -- Example: - - Run CoreTemp ["-t", "Temp:<core0>|<core1>C", - "-L", "40", "-H", "60", - "-l", "lightblue", "-n", "gray90", "-h", "red"] 50 - -## `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. - - `--hwmonitor-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: <max>°C - <maxpc>%` -- This monitor requires coretemp module to be loaded in kernel -- Example: - - Run MultiCoreTemp ["-t", "Temp: <avg>°C | <avgpc>%", - "-L", "60", "-H", "80", - "-l", "green", "-n", "yellow", "-h", "red", - "--", "--mintemp", "20", "--maxtemp", "100"] 50 - -## `Volume Mixer Element Args RefreshRate` - -- Aliases to the mixer name and element name separated by a colon. Thus, - `Volume "default" "Master" [] 10` can be used as `%default:Master%`. -- Args: default monitor arguments. Also accepts: - - `-O` _string_ On string - - The string used in place of `<status>` when the mixer element - is on. Defaults to "[on]". - - Long option: `--on` - - `-o` _string_ Off string - - The string used in place of `<status>` when the mixer element - is off. Defaults to "[off]". - - Long option: `--off` - - `-C` _color_ On color - - The color to be used for `<status>` when the mixer element - is on. Defaults to "green". - - Long option: `--onc` - - `-c` _color_ Off color - - The color to be used for `<status>` when the mixer element - is off. Defaults to "red". - - Long option: `--offc` - - `--highd` _number_ High threshold for dB. Defaults to -5.0. - - `--lowd` _number_ Low threshold for dB. Defaults to -30.0. - - `--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 `<status>` 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 `<status>` 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 `<status>` 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: <volume>% <status>` -- Requires the package [alsa-core] and [alsa-mixer] installed in your - system. In addition, to activate this plugin you must pass - `--flags="with_alsa"` during compilation. - -## `Alsa Mixer Element Args` - -Like [Volume](#volume-mixer-element-args-refreshrate), 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`. - -## `MPD Args RefreshRate` - -- This monitor will only be compiled if you ask for it using the - `with_mpd` flag. It needs [libmpd] 5.0 or later (available on Hackage). -- Aliases to `mpd` -- Args: default monitor arguments. 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: <state>` -- Example (note that you need "--" to separate regular monitor options from - MPD's specific ones): - - Run MPD ["-t", - "<composer> <title> (<album>) <track>/<plength> <statei> [<flags>]", - "--", "-P", ">>", "-Z", "|", "-S", "><"] 10 - -## `Mpris1 PlayerName Args RefreshRate` - -- Aliases to `mpris1` -- Requires [dbus] and [text] packages. - To activate, pass `--flags="with_mpris"` 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: - - Run Mpris1 "clementine" ["-t", "<artist> - [<tracknumber>] <title>"] 10 - -## `Mpris2 PlayerName Args RefreshRate` - -- Aliases to `mpris2` -- Requires [dbus] and [text] packages. - To activate, pass `--flags="with_mpris"` 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: - - Run Mpris2 "spotify" ["-t", "<artist> - [<composer>] <title>"] 10 - -## `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 - [hinotify] package. To activate, pass `--flags="with_inotify"` - during compilation. -- Example: - - Run Mail [("inbox", "~/var/mail/inbox"), - ("lists", "~/var/mail/lists")] - "mail" - -## `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 - [hinotify] package. To activate, pass `--flags="with_inotify"` - during compilation. -- Example: - - Run MailX [("I", "inbox", "green"), - ("L", "lists", "orange")] - ["-d", "~/var/mail", "-p", " ", "-s", " "] - "mail" - - -## `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 - [hinotify] package. To activate, pass `--flags="with_inotify"` - 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`: - - Run MBox [("I ", "inbox", "red"), ("O ", "~/foo/mbox", "")] - ["-d", "/var/mail/", "-p", " "] "mbox" - -## `XPropertyLog PropName` - -- Aliases to `PropName` -- Reads the X property named by `PropName` (a string) and displays its - value. The [examples/xmonadpropwrite.hs script] in xmobar's - distribution can be used to set the given property from the output - of any other program or script. - -[examples/xmonadpropwrite.hs script]: https://github.com/jaor/xmobar/raw/master/examples/xmonadpropwrite.hs - -## `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. - -## `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: `<percent>` -- Example: - - Run Brightness ["-t", "<bar>"] 60 - -## `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: - - Run Kbd [("us(dvorak)", "DV"), ("us", "US")] - -## `Locks` - -- Displays the status of Caps Lock, Num Lock and Scroll Lock. -- Aliases to `locks` -- Example: - - Run Locks - -## `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: - - Run CatInt 0 "/sys/devices/platform/thinkpad_hwmon/fan1_input" [] 50 - -## `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: - - Run UVMeter "Brisbane" ["-H", "3", "-L", "3", "--low", "green", "--high", "red"] 900 - -# 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.: - - Run Com "uname" ["-s","-r"] "" 0 - -can be used in the output template as `%uname%` (and xmobar will call -_uname_ only once), while - - Run Com "date" ["+\"%a %b %_d %H:%M\""] "mydate" 600 - -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: - - Run ComX "date" ["+\"%a %b %_d %H:%M\""] "N/A" "mydate" 600 - -will display "N/A" if for some reason the `date` invocation fails. - -# Other Plugins - -## `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. -- Will not do anything to the text received. This means you can pass dynamic - actions via stdin. Be careful to escape (using `<raw=…>`) or remove tags - from dynamic text that you pipe-thru to xmobar's standard input, e.g. - window's title. -- Sample usage: send to xmobar's stdin the list of your workspaces enclosed by - actions tags that switches the workspaces to be able to switch workspaces by - clicking on xmobar: - ```<action=`xdotool key alt+1`>ws1</action> <action=`xdotool key alt+1`>ws2</action>``` - -## `Date Format Alias RefreshRate` - -- Format is a time format string, as accepted by the standard ISO C - `strftime` function (or Haskell's `formatCalendarTime`). -- Sample usage: `Run Date "%a %b %_d %Y <fc=#ee9a00>%H:%M:%S</fc>" "date" 10` - -## `DateZone Format Locale Zone Alias RefreshRate` - -- Format is a time format string, as accepted by the standard ISO C - `strftime` function (or Haskell's `formatCalendarTime`). -- If Locale is "" the default locale of the system is used, otherwise the given - locale. If there are more instances of DateZone, using "" as input for Locale - is not recommended. -- Zone is the name of the TimeZone. It is assumed that the tz database is stored - in /usr/share/zoneinfo/. If "" is given as Zone, the default system time is - used. -- Sample usage: - `Run DateZone "%a %H:%M:%S" "de_DE.UTF-8" "Europe/Vienna" "viennaTime" 10` - -## `CommandReader "/path/to/program" Alias` - -- Runs the given program, and displays its standard output. - -## `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 - - Run MarqueePipeReader "/tmp/testpipe" (10, 7, "+") "mpipe" - -- 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: - - Run BufferedPipeReader "bpr" - [ ( 0, False, "/tmp/xmobar_window" ) - , ( 15, True, "/tmp/xmobar_status" ) - ] - - Have your window manager send window titles to - `"/tmp/xmobar_window"`. They will always be shown and not reveal - your xmobar. Sending some status information to - `"/tmp/xmobar_status"` will reveal xmonad for 1.5 seconds and - temporarily overwrite the window titles. -- Take a look at [examples/status.sh] -- Expands environment variables for the pipe path - -[examples/status.sh]: http://github.com/jaor/xmobar/raw/master/examples/status.sh - - -## `XMonadLog` - -- Aliases to XMonadLog -- Displays information from xmonad's `_XMONAD_LOG`. You can set this - property by using `xmonadPropLog` as your log hook in xmonad's - configuration, as in the following example (more info [here]): - - main = do - spawn "xmobar" - xmonad $ defaultConfig { - logHook = dynamicLogString defaultPP >>= xmonadPropLog - } - This plugin can be used as a sometimes more convenient alternative - to `StdinReader`. For instance, it allows you to (re)start xmobar - outside xmonad. - -[here]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html - -## `UnsafeXMonadLog` - -- Aliases to UnsafeXMonadLog -- Similar to StdinReader versus UnsafeStdinReader, this does not strip `<action - ...>` tags from XMonad's `_XMONAD_LOG`. -- It is advised that you still use `xmobarStrip` for the ppTitle in your - logHook: - - myPP = defaultPP { ppTitle = xmobarStrip } - main = xmonad $ defaultConfig { - logHook = dynamicLogString myPP >>= xmonadPropLog - } - -## `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: - - (readHandle, writeHandle) <- createPipe - xmobarProcess <- forkProcess $ xmobar myConfig - { commands = - Run (HandleReader readHandle "handle") : commands myConfig - } - hPutStr writeHandle "Hello World" - -# The DBus Interface - -When compiled with the optional `with_dbus` flag, xmobar can be -controlled over dbus. All signals defined in [src/Signal.hs] as `data -SignalType` can now be sent over dbus to xmobar. Due to current -limitations of the implementation only one process of xmobar can -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. - -[src/Signal.hs]: https://github.com/jaor/xmobar/blob/master/src/Xmobar/System/Signal.hs - -- Bus Name: `org.Xmobar.Control` -- Object Path: `/org/Xmobar/Control` -- Member Name: Any of SignalType, e.g. `string:Reveal` -- Interface Name: `org.Xmobar.Control` - -An example using the `dbus-send` command line utility: - - dbus-send \ - --session \ - --dest=org.Xmobar.Control \ - --type=method_call \ - --print-reply \ - '/org/Xmobar/Control' \ - org.Xmobar.Control.SendSignal \ - "string:Toggle 0" - -It is also possible to send multiple signals at once: - - # send to another screen, reveal and toggle the persistent flag - dbus-send [..] \ - "string:ChangeScreen 0" "string:Reveal 0" "string:TogglePersistent" - -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. - -## Example for using the DBus IPC interface with XMonad - -Bind the key which should {,un}map xmobar to a dummy value. This is necessary -for {,un}grabKey in xmonad. - - ((0, xK_Alt_L ), return ()) - -Also, install `avoidStruts` layout modifier from `XMonad.Hooks.ManageDocks` - -Finally, install these two event hooks (`handleEventHook` in `XConfig`) -`myDocksEventHook` is a replacement for `docksEventHook` which reacts on unmap -events as well (which `docksEventHook` doesn't). - - import qualified XMonad.Util.ExtensibleState as XS - - data DockToggleTime = DTT { lastTime :: Time } deriving (Eq, Show, Typeable) - - instance ExtensionClass DockToggleTime where - initialValue = DTT 0 - - toggleDocksHook :: Int -> KeySym -> Event -> X All - toggleDocksHook to ks ( KeyEvent { ev_event_display = d - , ev_event_type = et - , ev_keycode = ekc - , ev_time = etime - } ) = - io (keysymToKeycode d ks) >>= toggleDocks >> return (All True) - where - toggleDocks kc - | ekc == kc && et == keyPress = do - safeSendSignal ["Reveal 0", "TogglePersistent"] - XS.put ( DTT etime ) - | ekc == kc && et == keyRelease = do - gap <- XS.gets ( (-) etime . lastTime ) - safeSendSignal [ "TogglePersistent" - , "Hide " ++ show (if gap < 400 then to else 0) - ] - | otherwise = return () - - safeSendSignal s = catchX (io $ sendSignal s) (return ()) - sendSignal = withSession . callSignal - withSession mc = connectSession >>= \c -> callNoReply c mc >> disconnect c - callSignal :: [String] -> MethodCall - callSignal s = ( methodCall - ( objectPath_ "/org/Xmobar/Control" ) - ( interfaceName_ "org.Xmobar.Control" ) - ( memberName_ "SendSignal" ) - ) { methodCallDestination = Just $ busName_ "org.Xmobar.Control" - , methodCallBody = map toVariant s - } - - toggleDocksHook _ _ _ = return (All True) - - myDocksEventHook :: Event -> X All - myDocksEventHook e = do - when (et == mapNotify || et == unmapNotify) $ - whenX ((not `fmap` (isClient w)) <&&> runQuery checkDock w) refresh - return (All True) - where w = ev_window e - et = ev_event_type e - -# User plugins - -## Writing a Plugin - -Writing a plugin for xmobar should be very simple. 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 1 needed method (alternatively `start` or `run`) and 2 -optional ones (alias and rate): - - start :: e -> (String -> IO ()) -> IO () - run :: e -> IO String - rate :: e -> Int - alias :: e -> String - -`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 `examples/xmobar.hs` for an -example of a plugin that runs just once, and -`src/Xmobar/Plugins/Date.hs` for one that implements `rate`. - -Notice that Date could be implemented as: - - 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 - -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. - -## Using a Plugin - -To use your new plugin, you need to use a pure Haskell configuration -for xmobar, and load your definitions there. You can see an example -in [examples/xmobar.hs](./examples/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, the Haskell code will be compiled as -needed, and the new executable spawned for you. - -That's it! - -## Configurations written in pure Haskell - -xmobar can be used as a pure Haskell program, that is compiled with -your specific configuration, expressed as Haskell source code. For an -example, see [the author's -configuration](https://gitlab.com/jaor/xmobar-config/). - -# Authors and credits - -Andrea Rossato originally designed and implemented xmobar up to -version 0.11.1. Since then, it is maintained and developed by [jao], -with the help of the greater xmobar and Haskell communities. - -In particular, xmobar [incorporates patches] by Mohammed Alshiekh, -Alex Ameen, Axel Angel, Dhananjay Balan, Claudio Bley, Dragos Boca, -Ben Boeckel, Duncan Burke, Roman Cheplyaka, Patrick Chilton, Antoine -Eiche, Nathaniel Wesley Filardo, John Goerzen, Reto Hablützel, Juraj -Hercek, Tomáš Janoušek, Ada Joule, Spencer Janssen, Roman Joost, -Jochen Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry -Kurochkin, Todd Lunter, Vanessa McHale, Robert J. Macomber, Dmitry -Malikov, David McLean, 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, Markus Scherer, Daniel -Schüssler, Olivier Schneider, Alexander Shabalin, Valentin Shirokov, -Peter Simons, Alexander Solovyov, Will Song, 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, Edward Z. Yang and Norbert Zeh. - -[jao]: http://jao.io -[incorporates patches]: http://www.ohloh.net/p/xmobar/contributors - -## Thanks - -__Andrea Rossato__: - -Thanks to Robert Manea and Spencer Janssen for their help in -understanding how X works. They gave me suggestions on how to solve -many problems with xmobar. - -Thanks to Claus Reinke for make me understand existential types (or at -least for letting me think I grasp existential types...;-). - -__jao__: - -Thanks to Andrea for creating xmobar in the first place, and for -giving me the chance to contribute. - -# Related - -- To understand the internal mysteries of xmobar you may try reading - [this tutorial] on X Window Programming in Haskell. - -- My [sawflibs] project includes a module to automate running xmobar - in [sawfish]. - -[this tutorial]: http://www.haskell.org/haskellwiki/X_window_programming_in_Haskell -[sawflibs]: http://github.com/jaor/sawflibs - -# License - -This software is released under a BSD-style license. See [license] for -more details. - -Copyright © 2010-2020 Jose Antonio Ortega Ruiz - -Copyright © 2007-2010 Andrea Rossato - -[Github]: http://github.com/jaor/xmobar/ -[Github page]: http://github.com/jaor/xmobar -[Hackage]: http://hackage.haskell.org/package/xmobar/ -[LICENSE]: https://github.com/jaor/xmobar/raw/master/license -[Mailing list]: http://projects.haskell.org/cgi-bin/mailman/listinfo/xmobar -[MPD]: http://mpd.wikia.com/ -[X11-xft]: http://hackage.haskell.org/package/X11-xft/ -[i3status]: http://i3wm.org/i3status/ -[i3status manual]: http://i3wm.org/i3status/manpage.html#_using_i3status_with_xmobar -[iwlib]: http://www.hpl.hp.com/personal/Jean_Tourrilhes/Linux/Tools.html -[libasound]: http://packages.debian.org/stable/libasound2-dev -[hinotify]: http://hackage.haskell.org/package/hinotify/ -[libmpd]: http://hackage.haskell.org/package/libmpd/ -[dbus]: http://hackage.haskell.org/package/dbus -[text]: http://hackage.haskell.org/package/text -[sawfish]: http://sawfish.wikia.com/ -[utf8-string]: http://hackage.haskell.org/package/utf8-string/ -[alsa-core]: http://hackage.haskell.org/package/alsa-core -[alsa-mixer]: http://hackage.haskell.org/package/alsa-mixer -[timezone-olson]: http://hackage.haskell.org/package/timezone-olson -[timezone-series]: http://hackage.haskell.org/package/timezone-series -[libXpm]: http://cgit.freedesktop.org/xorg/lib/libXpm -[http-conduit]: http://hackage.haskell.org/package/http-conduit -[http-types]: http://hackage.haskell.org/package/http-types diff -pruN 0.36-2/readme.org 0.46-1/readme.org --- 0.36-2/readme.org 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/readme.org 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,195 @@ +#+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 diff -pruN 0.36-2/setup.lhs 0.46-1/setup.lhs --- 0.36-2/setup.lhs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/setup.lhs 1970-01-01 00:00:00.000000000 +0000 @@ -1,4 +0,0 @@ -#!/usr/bin/env runhaskell - -> import Distribution.Simple -> main = defaultMainWithHooks simpleUserHooks diff -pruN 0.36-2/src/Xmobar/App/Compile.hs 0.46-1/src/Xmobar/App/Compile.hs --- 0.36-2/src/Xmobar/App/Compile.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/App/Compile.hs 2001-09-09 01:46:40.000000000 +0000 @@ -165,7 +165,7 @@ recompile confDir dataDir execName force #ifdef THREADED_RUNTIME ++ ["-threaded"] #endif -#ifdef DRTSOPTS +#ifdef RTSOPTS ++ ["-rtsopts", "-with-rtsopts", "-V0"] #endif ++ ["-o", bin] diff -pruN 0.36-2/src/Xmobar/App/Config.hs 0.46-1/src/Xmobar/App/Config.hs --- 0.36-2/src/Xmobar/App/Config.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/App/Config.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Config.Defaults --- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -21,6 +21,7 @@ module Xmobar.App.Config (defaultConfig, xmobarConfigFile) where import Control.Monad (when, filterM) +import Data.Functor ((<&>)) import System.Environment import System.Directory @@ -63,6 +64,10 @@ defaultConfig = , 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 @@ -105,7 +110,7 @@ findFirstDirOf create possibles = do go [] = return Nothing go (x:xs) = do exists <- x >>= doesDirectoryExist - if exists then x >>= return . Just else go xs + if exists then x <&> Just else go xs -- | Simple wrapper around @findFirstDirOf@ that allows the primary -- path to be specified by an environment variable. diff -pruN 0.36-2/src/Xmobar/App/EventLoop.hs 0.46-1/src/Xmobar/App/EventLoop.hs --- 0.36-2/src/Xmobar/App/EventLoop.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/App/EventLoop.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,282 +0,0 @@ -{-# LANGUAGE CPP #-} - ------------------------------------------------------------------------------- --- | --- Module: Xmobar.X11.EventLoop --- Copyright: (c) 2018, 2020 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.App.EventLoop - ( startLoop - , startCommand - , newRefreshLock - , refreshLock - ) where - -import Prelude hiding (lookup) -import Graphics.X11.Xlib hiding (textExtents, textWidth) -import Graphics.X11.Xlib.Extras -import Graphics.X11.Xinerama -import Graphics.X11.Xrandr - -import Control.Arrow ((&&&)) -import Control.Monad.Reader -import Control.Concurrent -import Control.Concurrent.Async (Async, async) -import Control.Concurrent.STM -import Control.Exception (bracket_, handle, SomeException(..)) -import Data.Bits -import Data.Map hiding (foldr, map, filter) -import Data.Maybe (fromJust, isJust) -import qualified Data.List.NonEmpty as NE - -import Xmobar.System.Signal -import Xmobar.Config.Types -import Xmobar.Run.Exec -import Xmobar.Run.Runnable -import Xmobar.X11.Actions -import Xmobar.X11.Parsers -import Xmobar.X11.Window -import Xmobar.X11.Text -import Xmobar.X11.Draw -import Xmobar.X11.Bitmap as Bitmap -import Xmobar.X11.Types -import Xmobar.System.Utils (safeIndex) - -#ifndef THREADED_RUNTIME -import Xmobar.X11.Events(nextEvent') -#endif - -#ifdef XFT -import Graphics.X11.Xft -#endif - -#ifdef DBUS -import Xmobar.System.DBus -#endif - -runX :: XConf -> X () -> IO () -runX xc f = runReaderT f xc - -newRefreshLock :: IO (TMVar ()) -newRefreshLock = atomically $ newTMVar () - -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 - --- | Starts the main event loop and threads -startLoop :: XConf - -> TMVar SignalType - -> TMVar () - -> [[([Async ()], TVar String)]] - -> IO () -startLoop xcfg@(XConf _ _ w _ _ _ _) sig pauser vs = do -#ifdef XFT - xftInitFtLibrary -#endif - tv <- atomically $ newTVar [] - _ <- forkIO (handle (handler "checker") (checker tv [] vs sig pauser)) -#ifdef THREADED_RUNTIME - _ <- forkOS (handle (handler "eventer") (eventer sig)) -#else - _ <- forkIO (handle (handler "eventer") (eventer sig)) -#endif -#ifdef DBUS - runIPC sig -#endif - eventLoop tv xcfg [] sig - where - handler thing (SomeException e) = - void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e) - -- Reacts on events from X - eventer signal = - allocaXEvent $ \e -> do - dpy <- openDisplay "" - xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask - selectInput dpy w (exposureMask .|. structureNotifyMask .|. buttonPressMask) - - forever $ do -#ifdef THREADED_RUNTIME - nextEvent dpy e -#else - nextEvent' dpy e -#endif - ev <- getEvent e - case ev of - ConfigureEvent {} -> atomically $ putTMVar signal Reposition - ExposeEvent {} -> atomically $ putTMVar signal Wakeup - RRScreenChangeNotifyEvent {} -> atomically $ putTMVar signal Reposition - ButtonEvent {} -> atomically $ - putTMVar signal (Action (ev_button ev) (fi $ ev_x ev)) - _ -> return () - --- | 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 signal pauser = do - nval <- atomically $ refreshLockT pauser $ do - nv <- mapM concatV vs - guard (nv /= ov) - writeTVar tvar nv - return nv - atomically $ putTMVar signal Wakeup - checker tvar nval vs signal pauser - where - concatV = fmap concat . mapM (readTVar . snd) - - --- | Continuously wait for a signal from a thread or a interrupt handler -eventLoop :: TVar [String] - -> XConf - -> [([Action], Position, Position)] - -> TMVar SignalType - -> IO () -eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do - typ <- atomically $ takeTMVar signal - case typ of - Wakeup -> do - str <- updateString cfg tv - xc' <- updateCache d w is (iconRoot cfg) str >>= - \c -> return xc { iconS = c } - as' <- updateActions xc r str - runX xc' $ drawInWin r str - eventLoop tv xc' as' signal - - Reposition -> - reposWindow cfg - - ChangeScreen -> do - ncfg <- updateConfigPosition cfg - reposWindow ncfg - - Hide t -> hide (t*100*1000) - Reveal t -> reveal (t*100*1000) - Toggle t -> toggle t - - TogglePersistent -> eventLoop - tv xc { config = cfg { persistent = not $ persistent cfg } } as signal - - Action but x -> action but x - - where - isPersistent = not $ persistent cfg - - hide t - | t == 0 = - when isPersistent (hideWindow d w) >> eventLoop tv xc as signal - | otherwise = do - void $ forkIO - $ threadDelay t >> atomically (putTMVar signal $ Hide 0) - eventLoop tv xc as signal - - reveal t - | t == 0 = do - when isPersistent (showWindow r cfg d w) - eventLoop tv xc as signal - | otherwise = do - void $ forkIO - $ threadDelay t >> atomically (putTMVar signal $ Reveal 0) - eventLoop tv xc as signal - - toggle t = do - ismapped <- isMapped d w - atomically (putTMVar signal $ if ismapped then Hide t else Reveal t) - eventLoop tv xc as signal - - reposWindow rcfg = do - r' <- repositionWin d w (NE.head fs) rcfg - eventLoop tv (XConf d r' w fs vos is rcfg) as signal - - updateConfigPosition ocfg = - case position ocfg of - OnScreen n o -> do - srs <- getScreenInfo d - return (if n == length srs - then - (ocfg {position = OnScreen 1 o}) - else - (ocfg {position = OnScreen (n+1) o})) - o -> return (ocfg {position = OnScreen 1 o}) - - action button x = do - mapM_ runAction $ - filter (\(Spawn b _) -> button `elem` b) $ - concatMap (\(a,_,_) -> a) $ - filter (\(_, from, to) -> x >= from && x <= to) as - eventLoop tv xc as signal - --- $command - --- | 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 <- atomically $ newTVar is - atomically $ writeTVar var (s ++ ss) - return ([], var) - | otherwise = do var <- atomically $ newTVar 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 - -updateString :: Config -> TVar [String] - -> IO [[(Widget, TextRenderInfo, Int, Maybe [Action])]] -updateString conf v = do - s <- readTVarIO v - let l:c:r:_ = s ++ repeat "" - liftIO $ mapM (parseString conf) [l, c, r] - -updateActions :: XConf -> Rectangle -> [[(Widget, TextRenderInfo, Int, Maybe [Action])]] - -> IO [([Action], Position, Position)] -updateActions conf (Rectangle _ _ wid _) ~[left,center,right] = do - let (d,fs) = (display &&& fontListS) conf - strLn :: [(Widget, TextRenderInfo, Int, Maybe [Action])] -> IO [(Maybe [Action], Position, Position)] - strLn = liftIO . mapM getCoords - iconW i = maybe 0 Bitmap.width (lookup i $ iconS conf) - getCoords (Text s,_,i,a) = textWidth d (safeIndex fs i) s >>= \tw -> return (a, 0, fi tw) - getCoords (Icon s,_,_,a) = return (a, 0, fi $ iconW s) - partCoord off xs = map (\(a, x, x') -> (fromJust a, x, x')) $ - filter (\(a, _,_) -> isJust a) $ - scanl (\(_,_,x') (a,_,w') -> (a, x', x' + w')) - (Nothing, 0, off) - xs - totSLen = foldr (\(_,_,len) -> (+) len) 0 - remWidth xs = fi wid - totSLen xs - offs = 1 - offset a xs = case a of - C -> (remWidth xs + offs) `div` 2 - R -> remWidth xs - L -> offs - fmap concat $ mapM (\(a,xs) -> - (\xs' -> partCoord (offset a xs') xs') <$> strLn xs) $ - zip [L,C,R] [left,center,right] diff -pruN 0.36-2/src/Xmobar/App/Main.hs 0.46-1/src/Xmobar/App/Main.hs --- 0.36-2/src/Xmobar/App/Main.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/App/Main.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Main --- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -17,70 +17,37 @@ module Xmobar.App.Main (xmobar, xmobarMain, configFromArgs) where -import Control.Concurrent.Async (Async, cancel) -import Control.Exception (bracket) -import Control.Monad (unless) -import Data.Foldable (for_) -import qualified Data.Map as Map 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 Data.List.NonEmpty (NonEmpty(..)) -import Graphics.X11.Xlib +import Control.Monad (unless) +import Xmobar.App.Config import Xmobar.Config.Types import Xmobar.Config.Parse -import Xmobar.System.Signal (setupSignalHandler, withDeferSignals) -import Xmobar.Run.Template -import Xmobar.X11.Types -import Xmobar.X11.Text -import Xmobar.X11.Window +import Xmobar.X11.Loop (x11Loop) +import Xmobar.Text.Loop (textLoop) import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts) -import Xmobar.App.EventLoop (startLoop, startCommand, newRefreshLock, refreshLock) import Xmobar.App.Compile (recompile, trace) -import Xmobar.App.Config -import Xmobar.App.Timer (withTimer) xmobar :: Config -> IO () -xmobar conf = withDeferSignals $ do - initThreads - d <- openDisplay "" - fs <- initFont d (font conf) - fl <- mapM (initFont d) (additionalFonts conf) - cls <- mapM (parseTemplate (commands conf) (sepChar conf)) - (splitTemplate (alignSep conf) (template conf)) - sig <- setupSignalHandler - refLock <- newRefreshLock - withTimer (refreshLock refLock) $ - bracket (mapM (mapM $ startCommand sig) cls) - cleanupThreads - $ \vars -> do - (r,w) <- createWin d fs conf - let ic = Map.empty - to = textOffset conf - ts = textOffsets conf ++ replicate (length fl) (-1) - startLoop (XConf d r w (fs :| fl) (to:ts) ic conf) sig refLock vars +xmobar cfg = if textOutput cfg then textLoop cfg else x11Loop cfg configFromArgs :: Config -> IO Config configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst -cleanupThreads :: [[([Async ()], a)]] -> IO () -cleanupThreads vars = - for_ (concat vars) $ \(asyncs, _) -> - for_ asyncs cancel - -buildLaunch :: Bool -> Bool -> String -> ParseError -> IO () -buildLaunch verb force p e = do +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 [] Nothing + 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)" @@ -106,5 +73,6 @@ xmobarMain = do Just p -> do r <- readConfig defaultConfig p case r of Left e -> - buildLaunch (verboseFlag flags) (recompileFlag flags) p e + buildLaunch (filter (/= p) args) (verboseFlag flags) + (recompileFlag flags) p e Right (c, defs) -> doOpts c flags >>= xmobar' defs diff -pruN 0.36-2/src/Xmobar/App/Opts.hs 0.46-1/src/Xmobar/App/Opts.hs --- 0.36-2/src/Xmobar/App/Opts.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/App/Opts.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Opts --- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -14,7 +14,10 @@ -- ------------------------------------------------------------------------------ -module Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts) where +module Xmobar.App.Opts ( recompileFlag + , verboseFlag + , getOpts + , doOpts) where import Control.Monad (when) import System.Console.GetOpt @@ -30,23 +33,26 @@ data Opts = Help | Verbose | Recompile | Version - | Font String - | BgColor String - | FgColor String - | Alpha String + | TextOutput (Maybe String) + | Font String + | AddFont String + | BgColor String + | FgColor String + | Alpha String | T | B | D - | AlignSep String - | Commands String + | AlignSep String + | Commands String | AddCommand String - | SepChar String - | Template String - | OnScr String - | IconRoot String - | Position String - | WmClass String - | WmName String + | SepChar String + | Template String + | OnScr String + | IconRoot String + | Position String + | WmClass String + | WmName String + | Dpi String deriving (Show, Eq) options :: [OptDescr Opts] @@ -55,7 +61,11 @@ options = , 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" ) @@ -86,6 +96,8 @@ options = "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]) @@ -104,7 +116,7 @@ usage = usageInfo header options ++ foot info :: String info = "xmobar " ++ showVersion version - ++ "\n (C) 2010 - 2020 Jose A Ortega Ruiz" + ++ "\n (C) 2010 - 2022 Jose A Ortega Ruiz" ++ "\n (C) 2007 - 2010 Andrea Rossato\n " ++ mail ++ "\n" ++ license ++ "\n" @@ -125,8 +137,13 @@ doOpts conf (o:oo) = 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}) @@ -147,6 +164,7 @@ doOpts conf (o:oo) = 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 diff -pruN 0.36-2/src/Xmobar/App/Timer.hs 0.46-1/src/Xmobar/App/Timer.hs --- 0.36-2/src/Xmobar/App/Timer.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/App/Timer.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,221 +0,0 @@ -{-# LANGUAGE LambdaCase #-} ------------------------------------------------------------------------------- --- | --- Module: Xmobar.App.Timer --- Copyright: (c) 2019 Tomáš Janoušek --- License: BSD3-style (see LICENSE) --- --- Maintainer: Tomáš Janoušek <tomi@nomi.cz> --- Stability: unstable --- --- Timer coalescing for recurring actions. --- ------------------------------------------------------------------------------- - -module Xmobar.App.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 <- atomically newEmptyTMVar - 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 -> atomically $ newTVar 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' diff -pruN 0.36-2/src/Xmobar/Config/Parse.hs 0.46-1/src/Xmobar/Config/Parse.hs --- 0.36-2/src/Xmobar/Config/Parse.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Config/Parse.hs 2001-09-09 01:46:40.000000000 +0000 @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Config.Parse --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -16,25 +16,29 @@ ------------------------------------------------------------------------------ -module Xmobar.Config.Parse(readConfig, parseConfig) where +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 -#if defined XFT || defined UTF8 import qualified System.IO as S (readFile) -#endif -readFileSafe :: FilePath -> IO String -#if defined XFT || defined UTF8 -readFileSafe = S.readFile -#else -readFileSafe = readFile -#endif +-- | 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 = @@ -56,28 +60,32 @@ parseConfig defaultConfig = x <- perms eof s <- getState - return (x,s) + return (x, s) perms = permute $ Config <$?> pFont <|?> pFontList <|?> pWmClass <|?> pWmName - <|?> pBgColor <|?> pFgColor - <|?> pPosition <|?> pTextOffset <|?> pTextOffsets + <|?> pBgColor <|?> pFgColor <|?> pPosition + <|?> pTextOutput <|?> pTextOutputFormat + <|?> pTextOffset <|?> pTextOffsets <|?> pIconOffset <|?> pBorder <|?> pBdColor <|?> pBdWidth <|?> pAlpha <|?> pHideOnStart <|?> pAllDesktops <|?> pOverrideRedirect <|?> pPickBroadest <|?> pLowerOnStart <|?> pPersistent <|?> pIconRoot <|?> pCommands <|?> pSepChar <|?> pAlignSep <|?> pTemplate - <|?> pVerbose + <|?> pVerbose <|?> pSignal <|?> pDpi - fields = [ "font", "additionalFonts","bgColor", "fgColor" + 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" + , "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" @@ -104,6 +112,10 @@ parseConfig defaultConfig = 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 @@ -174,4 +186,18 @@ commandsErr = "commands: this usually me -- parsed. readConfig :: Config -> FilePath -> IO (Either ParseError (Config,[String])) readConfig defaultConfig f = - liftIO (readFileSafe f) >>= return . parseConfig defaultConfig + 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) diff -pruN 0.36-2/src/Xmobar/Config/Template.hs 0.46-1/src/Xmobar/Config/Template.hs --- 0.36-2/src/Xmobar/Config/Template.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Config/Template.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,188 @@ +------------------------------------------------------------------------------ +-- | +-- 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) diff -pruN 0.36-2/src/Xmobar/Config/Types.hs 0.46-1/src/Xmobar/Config/Types.hs --- 0.36-2/src/Xmobar/Config/Types.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Config/Types.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,6 +1,6 @@ ----------------------------------------------------------------------------- -- | --- Module : Xmobar.Config +-- Module : Xmobar.Config.Types -- Copyright : (c) Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -13,13 +13,29 @@ ----------------------------------------------------------------------------- module Xmobar.Config.Types - ( -- * Configuration - -- $config - Config (..) - , XPosition (..), Align (..), Border(..) + ( Config (..) + , XPosition (..), Align (..), Border (..), TextOutputFormat (..) + , Segment + , FontIndex + , Box(..) + , BoxBorder(..) + , BoxOffset(..) + , BoxMargins(..) + , TextRenderInfo(..) + , Widget(..) + , SignalChan (..) + , Action (..) + , Button ) where -import Xmobar.Run.Runnable (Runnable(..)) +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 @@ -33,6 +49,9 @@ data Config = , 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 @@ -54,8 +73,8 @@ data Config = , persistent :: Bool -- ^ Whether automatic hiding should -- be enabled or disabled , iconRoot :: FilePath -- ^ Root folder for icons - , commands :: [Runnable] -- ^ For setting the command, - -- the command arguments + , 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 @@ -65,21 +84,98 @@ data Config = -- right text alignment , template :: String -- ^ The output template , verbose :: Bool -- ^ Emit additional debug messages - } deriving (Read) + , 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) -data XPosition = Top - | TopW Align Int - | TopSize Align Int Int - | TopP Int Int + -- | Bottom of the screen, full width, auto height | Bottom - | BottomP Int Int - | BottomW Align Int - | BottomSize Align Int Int - | Static {xpos, ypos, width, height :: Int} - | OnScreen Int XPosition - deriving ( Read, Eq ) -data Align = L | R | C deriving ( Read, Eq ) + | 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 @@ -88,4 +184,48 @@ data Border = NoBorder | TopBM Int | BottomBM Int | FullBM Int - deriving ( Read, Eq ) + 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]) diff -pruN 0.36-2/src/Xmobar/Draw/Boxes.hs 0.46-1/src/Xmobar/Draw/Boxes.hs --- 0.36-2/src/Xmobar/Draw/Boxes.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Draw/Boxes.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,67 @@ +------------------------------------------------------------------------------ +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Draw/Cairo.hs 0.46-1/src/Xmobar/Draw/Cairo.hs --- 0.36-2/src/Xmobar/Draw/Cairo.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Draw/Cairo.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,195 @@ +{-# 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'' diff -pruN 0.36-2/src/Xmobar/Draw/Types.hs 0.46-1/src/Xmobar/Draw/Types.hs --- 0.36-2/src/Xmobar/Draw/Types.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Draw/Types.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,36 @@ +------------------------------------------------------------------------------ +-- | +-- 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]] + } diff -pruN 0.36-2/src/Xmobar/Plugins/Command.hs 0.46-1/src/Xmobar/Plugins/Command.hs --- 0.36-2/src/Xmobar/Plugins/Command.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Command.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,54 @@ +------------------------------------------------------------------------------ +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Date.hs 0.46-1/src/Xmobar/Plugins/Date.hs --- 0.36-2/src/Xmobar/Plugins/Date.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Date.hs 2001-09-09 01:46:40.000000000 +0000 @@ -17,14 +17,16 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Date (Date(..)) where +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) @@ -32,15 +34,18 @@ data Date = Date String String Int instance Exec Date where alias (Date _ a _) = a rate (Date _ _ r) = r - start (Date f _ r) cb = do - t <- getCurrentTime - zone <- getTimeZone t - go zone - where - go zone = doEveryTenthSeconds r $ date zone f >>= cb - -date :: TimeZone -> String -> IO String -date timezone format = do - time <- getCurrentTime - let zonedTime = utcToZonedTime timezone time - pure $ formatTime defaultTimeLocale format zonedTime + 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) diff -pruN 0.36-2/src/Xmobar/Plugins/EWMH.hs 0.46-1/src/Xmobar/Plugins/EWMH.hs --- 0.36-2/src/Xmobar/Plugins/EWMH.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/EWMH.hs 2001-09-09 01:46:40.000000000 +0000 @@ -23,11 +23,7 @@ import Control.Monad.Reader import Graphics.X11 hiding (Modifier, Color) import Graphics.X11.Xlib.Extras import Xmobar.Run.Exec -#ifdef UTF8 -#undef UTF8 import Codec.Binary.UTF8.String as UTF8 -#define UTF8 -#endif import Foreign.C (CChar, CLong) import Xmobar.X11.Events (nextEvent') @@ -256,10 +252,4 @@ updateDesktop w = do _ -> return () decodeCChar :: [CChar] -> String -#ifdef UTF8 -#undef UTF8 decodeCChar = UTF8.decode . map fromIntegral -#define UTF8 -#else -decodeCChar = map (toEnum . fromIntegral) -#endif diff -pruN 0.36-2/src/Xmobar/Plugins/Kbd.hs 0.46-1/src/Xmobar/Plugins/Kbd.hs --- 0.36-2/src/Xmobar/Plugins/Kbd.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Kbd.hs 2001-09-09 01:46:40.000000000 +0000 @@ -14,9 +14,11 @@ module Xmobar.Plugins.Kbd(Kbd(..)) where -import Data.List (isPrefixOf, findIndex) -import Data.Maybe (fromJust) +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 @@ -27,47 +29,46 @@ import Xmobar.System.Kbd -- 'Bad' prefixes of layouts noLaySymbols :: [String] -noLaySymbols = ["group", "inet", "ctr", "pc", "ctrl", "terminate"] +noLaySymbols = ["group", "inet", "ctr", "compose", "pc", "ctrl", "terminate"] -- splits the layout string into the actual layouts splitLayout :: String -> [String] -splitLayout s = splitLayout' noLaySymbols $ split s '+' - -splitLayout' :: [String] -> [String] -> [String] --- end of recursion, remove empty strings -splitLayout' [] s = map (takeWhile (/= ':')) $ filter (not . null) s --- remove current string if it has a 'bad' prefix -splitLayout' bad s = - splitLayout' (tail bad) [x | x <- s, not $ isPrefixOf (head bad) x] +splitLayout s + = filter flt + . map (takeWhile (/= ':')) + $ split (=='+') s + where + flt "" = False + flt s' = not $ any (`isPrefixOf` s') noLaySymbols -- split String at each Char -split :: String -> Char -> [String] -split [] _ = [""] -split (c:cs) delim - | c == delim = "" : rest - | otherwise = (c : head rest) : tail rest - where - rest = split cs delim +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 = let c = findIndex (\x -> fst x == s) opts in - case c of - Nothing -> s - x -> let i = fromJust x in snd $ opts!!i +searchReplaceLayout opts s = fromMaybe s $ lookup s opts -- returns the active layout getKbdLay :: Display -> KbdOpts -> IO String getKbdLay dpy opts = do - lay <- getLayoutStr dpy - curLay <- getKbdLayout dpy - return $ searchReplaceLayout opts $ splitLayout lay!!curLay - - + 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) diff -pruN 0.36-2/src/Xmobar/Plugins/Kraken.hs 0.46-1/src/Xmobar/Plugins/Kraken.hs --- 0.36-2/src/Xmobar/Plugins/Kraken.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Kraken.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,160 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Batt/Common.hs 0.46-1/src/Xmobar/Plugins/Monitors/Batt/Common.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Batt/Common.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Batt/Common.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,57 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Batt/FreeBSD.hs 0.46-1/src/Xmobar/Plugins/Monitors/Batt/FreeBSD.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Batt/FreeBSD.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Batt/FreeBSD.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,46 @@ +----------------------------------------------------------------------------- +-- | +-- 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) diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Batt/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Batt/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Batt/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Batt/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,203 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Batt.hs 0.46-1/src/Xmobar/Plugins/Monitors/Batt.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Batt.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Batt.hs 2001-09-09 01:46:40.000000000 +0000 @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Batt --- Copyright : (c) 2010, 2011, 2012, 2013, 2015, 2016, 2018, 2019 Jose A Ortega +-- Copyright : (c) 2010-2013, 2015, 2016, 2018, 2019, 2022 Jose A Ortega -- (c) 2010 Andrea Rossato, Petr Rockai -- License : BSD-style (see LICENSE) -- @@ -15,46 +15,18 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Monitors.Batt ( battConfig, runBatt, runBatt' ) where +module Xmobar.Plugins.Monitors.Batt (battConfig, runBatt, runBatt') where -import System.Process (system) -import Control.Monad (void, unless) +import Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..), Result(..), Status(..)) import Xmobar.Plugins.Monitors.Common -import Control.Exception (SomeException, handle) -import System.FilePath ((</>)) -import System.IO (IOMode(ReadMode), hGetLine, withFile) -import System.Posix.Files (fileExist) -#ifdef FREEBSD -import System.BSD.Sysctl (sysctlReadInt) -#endif import System.Console.GetOpt -import Data.List (sort, sortBy, group) -import Data.Maybe (fromMaybe) -import Data.Ord (comparing) -import Text.Read (readMaybe) - -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 - } + +#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 @@ -108,33 +80,10 @@ options = , Option "" ["highs"] (ReqArg (\x o -> o { highString = x }) "") "" ] -data Status = Charging | Discharging | Full | Idle | Unknown deriving (Read, Eq) --- Result perc watts time-seconds Status -data Result = Result Float Float Float Status | NA - -sysDir :: FilePath -sysDir = "/sys/class/power_supply" - battConfig :: IO MConfig -battConfig = mkMConfig - "Batt: <watts>, <left>% / <timeleft>" -- template - ["leftbar", "leftvbar", "left", "acstatus", "timeleft", "watts", "leftipat"] -- replacements - -data Files = Files - { fFull :: String - , fNow :: String - , fVoltage :: String - , fCurrent :: String - , fStatus :: String - , isCurrent :: Bool - } | NoFiles deriving Eq - -data Battery = Battery - { full :: !Float - , now :: !Float - , power :: !Float - , status :: !String - } +battConfig = mkMConfig "Batt: <watts>, <left>% / <timeleft>" vs + where vs = ["leftbar", "leftvbar", "left" + , "acstatus", "timeleft", "watts", "leftipat"] data BatteryStatus = BattHigh @@ -153,130 +102,13 @@ getBattStatus charge opts where c = 100 * min 1 charge -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 - --- | FreeBSD battery query -#ifdef FREEBSD -battStatusFbsd :: Int -> Status -battStatusFbsd x - | x == 1 = Discharging - | x == 2 = Charging - | otherwise = Unknown - -readBatteriesFbsd :: BattOpts -> IO Result -readBatteriesFbsd 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 (battStatusFbsd $ fromIntegral st) - unless ac (maybeAlert opts p) - return (Result p w t sts) - -#else --- | query linux battery -safeFileExist :: String -> String -> IO Bool -safeFileExist d f = handle noErrors $ fileExist (d </> f) - where noErrors = const (return False) :: SomeException -> IO Bool - -batteryFiles :: String -> IO Files -batteryFiles bat = - do is_charge <- exists "charge_now" - is_energy <- if is_charge then return False else exists "energy_now" - is_power <- exists "power_now" - plain <- exists (if is_charge then "charge_full" else "energy_full") - let cf = if is_power then "power_now" else "current_now" - sf = if plain then "" else "_design" - return $ case (is_charge, is_energy) of - (True, _) -> files "charge" cf sf is_power - (_, True) -> files "energy" cf sf is_power - _ -> NoFiles - where prefix = sysDir </> bat - exists = safeFileExist prefix - files ch cf sf ip = Files { fFull = prefix </> ch ++ "_full" ++ sf - , fNow = prefix </> ch ++ "_now" - , fCurrent = prefix </> cf - , fVoltage = prefix </> "voltage_now" - , fStatus = prefix </> "status" - , isCurrent = not ip} - -haveAc :: FilePath -> IO Bool -haveAc f = - handle onError $ withFile (sysDir </> f) ReadMode (fmap (== "1") . hGetLine) - where onError = const (return False) :: SomeException -> IO Bool - -readBattery :: Float -> Files -> IO Battery -readBattery _ NoFiles = return $ Battery 0 0 0 "Unknown" -readBattery sc files = - do a <- grab $ fFull files - b <- grab $ fNow files - d <- grab $ fCurrent files - s <- grabs $ fStatus files - let sc' = if isCurrent files then sc / 10 else sc - a' = max a b -- sometimes the reported max charge is lower than - return $ Battery (3600 * a' / sc') -- wattseconds - (3600 * b / sc') -- wattseconds - (abs d / sc') -- watts - s -- string: Discharging/Charging/Full - where grab f = handle onError $ withFile f ReadMode (fmap read . hGetLine) - onError = const (return (-1)) :: SomeException -> IO Float - grabs f = handle onError' $ withFile f ReadMode hGetLine - onError' = const (return "Unknown") :: SomeException -> IO String - --- 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) - -readBatteriesLinux :: BattOpts -> [Files] -> IO Result -readBatteriesLinux opts bfs = - do let bfs' = filter (/= NoFiles) 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) - 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 -#endif - 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 -#ifdef FREEBSD - c <- io $ readBatteriesFbsd opts -#else - c <- io $ readBatteriesLinux opts =<< mapM batteryFiles bfs -#endif + c <- io $ MB.readBatteries opts bfs formatResult c opts formatResult :: Result -> BattOpts -> Monitor String @@ -295,48 +127,53 @@ formatResult res bopt = do (100 * x) parseTemplate (l ++ [st, fmtTime $ floor t, ws, si]) NA -> getConfigValue naString - where fmtPercent :: Float -> Bool -> Monitor [String] - fmtPercent x sp = do - let x' = minimum [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] - fmtWatts x o s d = do - ws <- showWithPadding $ showDigits d x ++ (if s then "W" else "") - return $ color x o ws - 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) - fmtStatus - :: BattOpts - -> Status - -> String -- ^ What to in case battery status is unknown - -> 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 Nothing str = str - maybeColor (Just c) str = "<fc=" ++ c ++ ">" ++ str ++ "</fc>" - color x o | x >= 0 = maybeColor (posColor o) - | -x >= highThreshold o = maybeColor (highWColor o) - | -x >= lowThreshold o = maybeColor (mediumWColor o) - | otherwise = maybeColor (lowWColor o) - getIconPattern opts st x = do - let x' = minimum [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' + +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' diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Common/Files.hs 0.46-1/src/Xmobar/Plugins/Monitors/Common/Files.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Common/Files.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Common/Files.hs 2001-09-09 01:46:40.000000000 +0000 @@ -14,7 +14,9 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Monitors.Common.Files (checkedDataRetrieval) where +module Xmobar.Plugins.Monitors.Common.Files ( checkedDataRetrieval + , checkedDataRead) +where #if __GLASGOW_HASKELL__ < 800 import Control.Applicative @@ -49,6 +51,11 @@ retrieveData path lbl trans fmt = do =<< 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] diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Common/Output.hs 0.46-1/src/Xmobar/Plugins/Monitors/Common/Output.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Common/Output.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Common/Output.hs 2001-09-09 01:46:40.000000000 +0000 @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Strings --- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -140,7 +140,7 @@ showWithUnits d n x padString :: Int -> Int -> String -> Bool -> String -> String -> String padString mnw mxw pad pr ellipsis s = let len = length s - rmin = if mnw <= 0 then 1 else mnw + 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 @@ -223,7 +223,7 @@ showPercentBar v x = do bw <- getConfigValue barWidth let c = bw < 1 w = if c then length bf else bw - len = min w $ round (fromIntegral w * x) + 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) @@ -261,9 +261,10 @@ logScaling f v = do 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 + | x <= ll = 1 / bw' + | otherwise = f + logBase 2 (x / hh) / bw' return $ scaled v showLogBar :: Float -> Float -> Monitor String diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Common/Types.hs 0.46-1/src/Xmobar/Plugins/Monitors/Common/Types.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Common/Types.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Common/Types.hs 2001-09-09 01:46:40.000000000 +0000 @@ -116,7 +116,7 @@ getMonitorConfig MC{..} = do pBarBack <- readIORef barBack pBarFore <- readIORef barFore pBarWidth <- readIORef barWidth - pUseSuffix <- readIORef useSuffix + pUseSuffix <- readIORef useSuffix pNaString <- readIORef naString pMaxTotalWidth <- readIORef maxTotalWidth pMaxTotalWidthEllipsis <- readIORef maxTotalWidthEllipsis diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Cpu/Common.hs 0.46-1/src/Xmobar/Plugins/Monitors/Cpu/Common.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Cpu/Common.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Cpu/Common.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,25 @@ +----------------------------------------------------------------------------- +-- | +-- 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 + } diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Cpu/FreeBSD.hs 0.46-1/src/Xmobar/Plugins/Monitors/Cpu/FreeBSD.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Cpu/FreeBSD.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Cpu/FreeBSD.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,54 @@ +----------------------------------------------------------------------------- +-- | +-- 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 + } diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Cpu/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Cpu/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Cpu/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Cpu/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,61 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/CpuFreq.hs 0.46-1/src/Xmobar/Plugins/Monitors/CpuFreq.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/CpuFreq.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/CpuFreq.hs 2001-09-09 01:46:40.000000000 +0000 @@ -22,7 +22,8 @@ import Xmobar.Plugins.Monitors.Common -- get more cpu frequencies. cpuFreqConfig :: IO MConfig cpuFreqConfig = - mkMConfig "Freq: <cpu0>" (map ((++) "cpu" . show) [0 :: Int ..]) + mkMConfig "Freq: <cpu0>" + (["max", "min", "avg"] ++ map ((++) "cpu" . show) [0 :: Int ..]) -- | @@ -32,12 +33,14 @@ runCpuFreq :: [String] -> Monitor String runCpuFreq _ = do suffix <- getConfigValue useSuffix ddigits <- getConfigValue decDigits - let path = ["/sys/devices/system/cpu/cpu", "/cpufreq/scaling_cur_freq"] + 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 - failureMessage <- getConfigValue naString - checkedDataRetrieval failureMessage [path] Nothing (/divisor) fmt + 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Cpu.hs 0.46-1/src/Xmobar/Plugins/Monitors/Cpu.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Cpu.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Cpu.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,9 +1,10 @@ +{-#LANGUAGE CPP #-} {-#LANGUAGE RecordWildCards#-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Cpu --- Copyright : (c) 2011, 2017 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2011, 2017, 2022 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -19,19 +20,25 @@ module Xmobar.Plugins.Monitors.Cpu ( startCpu , runCpu , cpuConfig - , CpuDataRef + , MC.CpuDataRef , CpuOpts , CpuArguments - , parseCpu + , MC.parseCpu , getArguments ) where import Xmobar.Plugins.Monitors.Common -import qualified Data.ByteString.Lazy.Char8 as B -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +import Data.IORef (newIORef) import System.Console.GetOpt -import Xmobar.App.Timer (doEveryTenthSeconds) +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 @@ -90,54 +97,6 @@ cpuConfig = , iowaitField ] -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 - -data CpuData = CpuData { - cpuUser :: !Float, - cpuNice :: !Float, - cpuSystem :: !Float, - cpuIdle :: !Float, - cpuIowait :: !Float, - cpuTotal :: !Float - } - -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 - data Field = Field { fieldName :: !String, fieldCompute :: !ShouldCompute @@ -202,7 +161,7 @@ optimizeAllTemplate args@CpuArguments {. data CpuArguments = CpuArguments - { cpuDataRef :: !CpuDataRef + { cpuDataRef :: !MC.CpuDataRef , cpuParams :: !MonitorConfig , cpuArgs :: ![String] , cpuOpts :: !CpuOpts @@ -214,9 +173,9 @@ data CpuArguments = getArguments :: [String] -> IO CpuArguments getArguments cpuArgs = do - initCpuData <- cpuData + initCpuData <- MC.cpuData cpuDataRef <- newIORef initCpuData - void $ parseCpu cpuDataRef + void $ MC.parseCpu cpuDataRef cpuParams <- computeMonitorConfig cpuArgs cpuConfig cpuInputTemplate <- runTemplateParser cpuParams cpuAllTemplate <- runExportParser (pExport cpuParams) @@ -237,7 +196,7 @@ getArguments cpuArgs = do runCpu :: CpuArguments -> IO String runCpu args@CpuArguments {..} = do - cpuValue <- parseCpu cpuDataRef + cpuValue <- MC.parseCpu cpuDataRef temMonitorValues <- formatCpu args cpuValue let templateInput = TemplateInput diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Disk/Common.hs 0.46-1/src/Xmobar/Plugins/Monitors/Disk/Common.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Disk/Common.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Disk/Common.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,21 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc 0.46-1/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc --- 0.36-2/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,403 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Disk/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Disk/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Disk/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Disk/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,148 @@ +----------------------------------------------------------------------------- +-- | +-- 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) diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Disk.hs 0.46-1/src/Xmobar/Plugins/Monitors/Disk.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Disk.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Disk.hs 2001-09-09 01:46:40.000000000 +0000 @@ -12,20 +12,25 @@ -- ----------------------------------------------------------------------------- +{-# LANGUAGE CPP #-} + module Xmobar.Plugins.Monitors.Disk (diskUConfig, runDiskU, startDiskIO) where import Xmobar.Plugins.Monitors.Common -import Xmobar.System.StatFS - -import Data.IORef (IORef, newIORef, readIORef, writeIORef) +#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.Exception (SomeException, handle) import Control.Monad (zipWithM) -import qualified Data.ByteString.Lazy.Char8 as B -import Data.List (isPrefixOf, find) -import Data.Maybe (catMaybes) -import System.Directory (canonicalizePath, doesFileExist) import System.Console.GetOpt +import Data.List (find) + +import Xmobar.Plugins.Monitors.Disk.Common ( + DevName + , Path + ) data DiskIOOpts = DiskIOOpts { totalIconPattern :: Maybe IconPattern @@ -93,103 +98,12 @@ diskUConfig = mkMConfig "" , "usedbar", "usedvbar", "usedipat" ] -type DevName = String -type Path = String -type DevDataRef = IORef [(DevName, [Float])] - -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') - speedToStr :: Float -> String speedToStr = showWithUnits 2 1 . (/ 1024) sizeToStr :: Integer -> String sizeToStr = showWithUnits 3 0 . fromIntegral -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 - runDiskIO' :: DiskIOOpts -> (String, [Float]) -> Monitor String runDiskIO' opts (tmp, xs) = do s <- mapM (showWithColors speedToStr) xs @@ -202,37 +116,25 @@ runDiskIO' opts (tmp, xs) = do setConfigValue tmp template parseTemplate $ s ++ b ++ vb ++ ipat -runDiskIO :: DevDataRef -> [(String, String)] -> [String] -> Monitor String +runDiskIO :: MD.DevDataRef -> [(String, String)] -> [String] -> Monitor String runDiskIO dref disks argv = do opts <- io $ parseOptsWith dioOptions dioDefaultOpts argv - dev <- io $ mountedOrDiskDevices (map fst disks) - dat <- io $ mountedData dref (map fst dev) - strs <- mapM (runDiskIO' opts) $ devTemplates disks dev dat + 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 - dev <- mountedOrDiskDevices (map fst disks) - dref <- newIORef (map (\d -> (fst d, repeat 0)) dev) - _ <- mountedData dref (map fst dev) + dref <- MD.initializeDevDataRef disks runM args diskIOConfig (runDiskIO dref disks) rate cb -fsStats :: String -> IO [Integer] -fsStats path = do - stats <- getFileSystemStats path - case stats of - Nothing -> return [0, 0, 0] - Just f -> let tot = fsStatByteCount f - free = fsStatBytesAvailable f - used = fsStatBytesUsed f - in return [tot, free, used] - -runDiskU' :: DiskUOpts -> String -> String -> Monitor String -runDiskU' opts tmp path = do +runDiskU' :: DiskUOpts -> String -> [Integer] -> Monitor String +runDiskU' opts tmp stat = do setConfigValue tmp template - [total, free, diff] <- io (handle ign $ fsStats path) - let strs = map sizeToStr [free, diff] + 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] @@ -244,12 +146,27 @@ runDiskU' opts tmp path = do uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr) uipat <- showIconPattern (usedIconPattern opts) (1 - fr) parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat] - where ign = const (return [0, 0, 0]) :: SomeException -> IO [Integer] - runDiskU :: [(String, String)] -> [String] -> Monitor String runDiskU disks argv = do - devs <- io $ mountedDevices (map fst disks) opts <- io $ parseOptsWith duOptions duDefaultOpts argv - strs <- mapM (\(d, p) -> runDiskU' opts (findTempl d p disks) p) devs + 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/K10Temp.hs 0.46-1/src/Xmobar/Plugins/Monitors/K10Temp.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/K10Temp.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/K10Temp.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,47 @@ +----------------------------------------------------------------------------- +-- | +-- 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' diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Load/Common.hs 0.46-1/src/Xmobar/Plugins/Monitors/Load/Common.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Load/Common.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Load/Common.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,21 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc 0.46-1/src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc --- 0.36-2/src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Load/FreeBSD.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,58 @@ +{-# 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) diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Load/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Load/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Load/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Load/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,37 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Load.hs 0.46-1/src/Xmobar/Plugins/Monitors/Load.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Load.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Load.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,46 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Mem/FreeBSD.hs 0.46-1/src/Xmobar/Plugins/Monitors/Mem/FreeBSD.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Mem/FreeBSD.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Mem/FreeBSD.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,45 @@ +----------------------------------------------------------------------------- +-- | +-- 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] diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Mem/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Mem/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Mem/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Mem/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,36 @@ +----------------------------------------------------------------------------- +-- | +-- 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] diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Mem.hs 0.46-1/src/Xmobar/Plugins/Monitors/Mem.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Mem.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Mem.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,3 +1,4 @@ +{-#LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Mem @@ -12,16 +13,23 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Monitors.Mem (memConfig, runMem, totalMem, usedMem) where +module Xmobar.Plugins.Monitors.Mem (memConfig, runMem) where import Xmobar.Plugins.Monitors.Common -import qualified Data.Map as M 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 @@ -29,6 +37,7 @@ defaultOpts = MemOpts { usedIconPattern = Nothing , freeIconPattern = Nothing , availableIconPattern = Nothing + , scale = 1.0 } options :: [OptDescr (MemOpts -> MemOpts)] @@ -39,52 +48,34 @@ options = 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)" -- template + "Mem: <usedratio>% (<cache>M)" ["usedbar", "usedvbar", "usedipat", "freebar", "freevbar", "freeipat", "availablebar", "availablevbar", "availableipat", "usedratio", "freeratio", "availableratio", - "total", "free", "buffer", "cache", "available", "used"] -- available replacements - -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] - -totalMem :: IO Float -totalMem = fmap ((*1024) . (!!1)) parseMEM - -usedMem :: IO Float -usedMem = fmap ((*1024) . (!!6)) parseMEM + "total", "free", "buffer", "cache", "available", "used"] formatMem :: MemOpts -> [Float] -> Monitor [String] formatMem opts (r:fr:ar:xs) = - do let f = showDigits 0 - mon i x = [showPercentBar (100 * x) x, showVerticalBar (100 * x) x, showIconPattern i x] + 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) xs + ++ map (showWithColors f . (/ scale opts)) xs formatMem _ _ = replicate 10 `fmap` getConfigValue naString runMem :: [String] -> Monitor String runMem argv = - do m <- io parseMEM + do m <- io MM.parseMEM opts <- io $ parseOptsWith options defaultOpts argv l <- formatMem opts m parseTemplate l diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/MPD.hs 0.46-1/src/Xmobar/Plugins/Monitors/MPD.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/MPD.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/MPD.hs 2001-09-09 01:46:40.000000000 +0000 @@ -95,7 +95,8 @@ mpdReady args = do parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts -> Monitor [String] -parseMPD (Left _) _ _ = return $ "N/A": repeat "" +parseMPD (Left _) _ _ = + getConfigValue naString >>= \na -> return $ na : repeat "" parseMPD (Right st) song opts = do songData <- parseSong song bar <- showPercentBar (100 * b) b diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs 0.46-1/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs 2001-09-09 01:46:40.000000000 +0000 @@ -16,9 +16,12 @@ module Xmobar.Plugins.Monitors.MultiCore 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. @@ -75,13 +78,32 @@ cTConfig = mkMConfig cTTemplate cTOption , "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 xs <- filterM doesDirectoryExist ps - return (if null xs then Nothing else Just $ head xs) - where ps = [ "/sys/bus/platform/devices/coretemp." ++ show (x :: Int) ++ "/" - | x <- [0..9] ] +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] @@ -89,10 +111,10 @@ hwmonPaths = do p <- coretempPath let (sc, path) = case p of Just s -> (False, s) Nothing -> (True, "/sys/class/") - let cps = [ path ++ "hwmon/hwmon" ++ show (x :: Int) ++ "/" - | x <- [0..9] ] + 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. @@ -100,11 +122,11 @@ corePaths :: Maybe String -> IO [String] corePaths s = do ps <- case s of Just pth -> return [pth] _ -> hwmonPaths - let cps = [p ++ "temp" ++ show (x :: Int) ++ "_label" - | x <- [0..9], p <- ps ] + 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Net/Common.hs 0.46-1/src/Xmobar/Plugins/Monitors/Net/Common.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Net/Common.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Net/Common.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,50 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc 0.46-1/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc --- 0.36-2/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Net/FreeBSD.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,117 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Net/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Net/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Net/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Net/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,69 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Net.hs 0.46-1/src/Xmobar/Plugins/Monitors/Net.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Net.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Net.hs 2001-09-09 01:46:40.000000000 +0000 @@ -11,9 +11,10 @@ -- -- A net device monitor for Xmobar -- + ----------------------------------------------------------------------------- -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE CPP #-} module Xmobar.Plugins.Monitors.Net ( startNet @@ -21,18 +22,18 @@ module Xmobar.Plugins.Monitors.Net ( ) where import Xmobar.Plugins.Monitors.Common - -import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) -import Data.Word (Word64) -import Control.Monad (forM, filterM) -import System.Directory (getDirectoryContents, doesFileExist) -import System.FilePath ((</>)) +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 -import System.IO.Error (catchIOError) -import System.IO.Unsafe (unsafeInterleaveIO) -import qualified Data.ByteString.Char8 as B +#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] @@ -79,70 +80,11 @@ instance Show UnitPerSec where show MBs = "MB/s" show GBs = "GB/s" -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 - netConfig :: IO MConfig netConfig = mkMConfig "<dev>: <rx>KB|<tx>KB" -- template ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat", "up"] -- available replacements -operstateDir :: String -> FilePath -operstateDir d = "/sys/class/net" </> d </> "operstate" - -existingDevs :: IO [String] -existingDevs = getDirectoryContents "/sys/class/net" >>= filterM isDev - where isDev d | d `elem` excludes = return False - | otherwise = doesFileExist (operstateDir d) - excludes = [".", "..", "lo"] - -isUp :: String -> IO Bool -isUp d = 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 - formatNet :: Maybe IconPattern -> Float -> Monitor (String, String, String, String) formatNet mipat d = do s <- getConfigValue useSuffix @@ -169,7 +111,7 @@ printNet opts nd = parseNet :: NetDevRef -> String -> IO NetDevRate parseNet nref nd = do (n0, t0) <- readIORef nref - n1 <- findNetDev nd + n1 <- MN.findNetDev nd t1 <- getCurrentTime writeIORef nref (n1, t1) let scx = realToFrac (diffUTCTime t1 t0) @@ -213,7 +155,7 @@ startNet i a r cb = do startDynNet :: [String] -> Int -> (String -> IO ()) -> IO () startDynNet a r cb = do - devs <- existingDevs + devs <- MN.existingDevs refs <- forM devs $ \d -> do t <- getCurrentTime nref <- newIORef (NA, t) diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc 0.46-1/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc --- 0.36-2/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,102 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Swap/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Swap/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Swap/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Swap/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,35 @@ +----------------------------------------------------------------------------- +-- | +-- 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] diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Swap.hs 0.46-1/src/Xmobar/Plugins/Monitors/Swap.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Swap.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Swap.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,3 +1,4 @@ +{-#LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Swap @@ -16,30 +17,15 @@ module Xmobar.Plugins.Monitors.Swap wher import Xmobar.Plugins.Monitors.Common -import qualified Data.ByteString.Lazy.Char8 as B +#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>%" -- template - ["usedratio", "total", "used", "free"] -- available replacements - -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] +swapConfig = mkMConfig "Swap: <usedratio>%" + ["usedratio", "total", "used", "free"] formatSwap :: [Float] -> Monitor [String] formatSwap (r:xs) = do @@ -47,10 +33,10 @@ formatSwap (r:xs) = do other <- mapM (showWithColors (showDigits d)) xs ratio <- showPercentWithColors r return $ ratio:other -formatSwap _ = return $ replicate 4 "N/A" +formatSwap _ = replicate 4 `fmap` getConfigValue naString runSwap :: [String] -> Monitor String runSwap _ = - do m <- io parseMEM + do m <- io MS.parseMEM l <- formatSwap m parseTemplate l diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Thermal.hs 0.46-1/src/Xmobar/Plugins/Monitors/Thermal.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Thermal.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Thermal.hs 2001-09-09 01:46:40.000000000 +0000 @@ -36,4 +36,4 @@ runThermal args = do then do number <- io $ fmap ((read :: String -> Int) . stringParser (1, 0)) (B.readFile file) thermal <- showWithColors show number parseTemplate [ thermal ] - else return $ "Thermal (" ++ zone ++ "): N/A" + else getConfigValue naString diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Top/Common.hs 0.46-1/src/Xmobar/Plugins/Monitors/Top/Common.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Top/Common.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Top/Common.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,32 @@ +----------------------------------------------------------------------------- +-- | +-- 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) diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc 0.46-1/src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc --- 0.36-2/src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Top/FreeBSD.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,143 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Top/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Top/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Top/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Top/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,92 @@ +----------------------------------------------------------------------------- +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Top.hs 0.46-1/src/Xmobar/Plugins/Monitors/Top.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Top.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Top.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,7 +1,9 @@ +{-#LANGUAGE CPP #-} +{-# LANGUAGE BangPatterns #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top --- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018 Jose A Ortega Ruiz +-- 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> @@ -12,24 +14,27 @@ -- ----------------------------------------------------------------------------- -{-# LANGUAGE ForeignFunctionInterface #-} -{-# LANGUAGE BangPatterns #-} - module Xmobar.Plugins.Monitors.Top (startTop, topMemConfig, runTopMem) where import Xmobar.Plugins.Monitors.Common -import Control.Exception (SomeException, handle) -import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import Data.List (sortBy, foldl') +import Data.IORef (newIORef, readIORef, writeIORef) +import Data.List (sortBy) import Data.Ord (comparing) -import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) -import System.Directory (getDirectoryContents) -import System.FilePath ((</>)) -import System.IO (IOMode(ReadMode), hGetLine, withFile) -import System.Posix.Unistd (SysVar(ClockTick), getSysVar) +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 -import Foreign.C.Types maxEntries :: Int maxEntries = 10 @@ -47,41 +52,6 @@ topConfig = mkMConfig "<both1>" , k <- [ "name", "cpu", "both" , "mname", "mem", "mboth"]]) -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) - showInfo :: String -> String -> Float -> Monitor [String] showInfo nm sms mms = do mnw <- getConfigValue maxWidth @@ -94,20 +64,10 @@ showInfo nm sms mms = do both <- showWithColors' (rnm ++ " " ++ sms) mms return [nm, mstr, both] -processName :: [String] -> String -processName = drop 1 . init . (!!1) sortTop :: [(String, Float)] -> [(String, Float)] sortTop = sortBy (flip (comparing snd)) -type MemInfo = (String, Float) - -meminfo :: [String] -> MemInfo -meminfo fs = (processName fs, pageSize * parseFloat (fs!!23)) - -meminfos :: IO [MemInfo] -meminfos = handleProcesses meminfo - showMemInfo :: Float -> MemInfo -> Monitor [String] showMemInfo scale (nm, rss) = showInfo nm (showWithUnits 3 1 rss) (100 * rss / sc) @@ -117,30 +77,8 @@ showMemInfos :: [MemInfo] -> Monitor [[S showMemInfos ms = mapM (showMemInfo tm) ms where tm = sum (map snd ms) -runTopMem :: [String] -> Monitor String -runTopMem _ = do - mis <- io meminfos - pstr <- showMemInfos (sortTop mis) - parseTemplate $ concat pstr - -type Pid = Int -type TimeInfo = (String, Float) -type TimeEntry = (Pid, TimeInfo) -type Times = [TimeEntry] -type TimesRef = IORef (Times, UTCTime) - -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 - timeMemInfos :: IO (Times, [MemInfo], Int) -timeMemInfos = fmap res timeMemEntries +timeMemInfos = fmap res MT.timeMemEntries where res x = (sortBy (comparing fst) $ map fst x, map snd x, length x) combine :: Times -> Times -> Times @@ -164,7 +102,7 @@ topProcesses tref scale = do c1 <- getCurrentTime let scx = realToFrac (diffUTCTime c1 c0) * scale !scx' = if scx > 0 then scx else scale - nts = map (\(_, (nm, t)) -> (nm, min 100 (t / scx'))) (combine t0 t1) + 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) @@ -178,18 +116,24 @@ showTimeInfo (n, 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 - parseTemplate $ show no : concat (zipWith (++) pstr mstr) ++ repeat "N/A" + na <- getConfigValue naString + parseTemplate $ show no : concat (zipWith (++) pstr mstr) ++ repeat na startTop :: [String] -> Int -> (String -> IO ()) -> IO () startTop a r cb = do - cr <- getSysVar ClockTick c <- getCurrentTime tref <- newIORef ([], c) - let scale = fromIntegral cr / 100 + scale <- MT.scale _ <- topProcesses tref scale runM a topConfig (runTop tref scale) r cb diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Uptime/FreeBSD.hsc 0.46-1/src/Xmobar/Plugins/Monitors/Uptime/FreeBSD.hsc --- 0.36-2/src/Xmobar/Plugins/Monitors/Uptime/FreeBSD.hsc 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Uptime/FreeBSD.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,52 @@ +------------------------------------------------------------------------------ +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Uptime/Linux.hs 0.46-1/src/Xmobar/Plugins/Monitors/Uptime/Linux.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Uptime/Linux.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Uptime/Linux.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,24 @@ +------------------------------------------------------------------------------ +-- | +-- 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") diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors/Uptime.hs 0.46-1/src/Xmobar/Plugins/Monitors/Uptime.hs --- 0.36-2/src/Xmobar/Plugins/Monitors/Uptime.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors/Uptime.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,3 +1,5 @@ +{-#LANGUAGE CPP #-} + ------------------------------------------------------------------------------ -- | -- Module : Plugins.Monitors.Uptime @@ -19,22 +21,22 @@ module Xmobar.Plugins.Monitors.Uptime (u import Xmobar.Plugins.Monitors.Common -import qualified Data.ByteString.Lazy.Char8 as B +#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"] -readUptime :: IO Float -readUptime = - fmap (read . B.unpack . head . B.words) (B.readFile "/proc/uptime") - secsPerDay :: Integer secsPerDay = 24 * 3600 uptime :: Monitor [String] uptime = do - t <- io readUptime + t <- io MU.readUptime u <- getConfigValue useSuffix let tsecs = floor t secs = tsecs `mod` secsPerDay diff -pruN 0.36-2/src/Xmobar/Plugins/Monitors.hs 0.46-1/src/Xmobar/Plugins/Monitors.hs --- 0.36-2/src/Xmobar/Plugins/Monitors.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/Monitors.hs 2001-09-09 01:46:40.000000000 +0000 @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar.Plugins.Monitors --- Copyright : (c) 2010, 2011, 2012, 2013, 2017, 2018, 2019 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2010-2013, 2017-2020, 2022 Jose Antonio Ortega Ruiz -- (c) 2007-10 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -30,11 +30,13 @@ 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 @@ -64,6 +66,7 @@ data Monitors = Network Interface | 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 @@ -74,6 +77,7 @@ data Monitors = Network Interface | CpuFreq Args Rate | CoreTemp Args Rate | MultiCoreTemp Args Rate + | K10Temp Slot Args Rate | TopProc Args Rate | TopMem Args Rate | Uptime Args Rate @@ -89,7 +93,8 @@ data Monitors = Network Interface | Wireless Interface Args Rate #endif #ifdef LIBMPD - | MPD Args Rate + | MPD Args Rate + | MPDX Args Rate Alias | AutoMPD Args #endif #ifdef ALSA @@ -112,6 +117,7 @@ type ZoneNo = Int type Interface = String type Rate = Int type DiskSpec = [(String, String)] +type Slot = String instance Exec Monitors where #ifdef WEATHER @@ -120,6 +126,7 @@ instance Exec Monitors where #endif alias (Network i _ _) = i alias (DynNetwork _ _) = "dynnetwork" + alias (Load _ _) = "load" alias (Thermal z _ _) = z alias (ThermalZone z _ _) = "thermal" ++ show z alias (Memory _ _) = "memory" @@ -135,6 +142,7 @@ instance Exec Monitors where alias (TopMem _ _) = "topmem" alias (CoreTemp _ _) = "coretemp" alias (MultiCoreTemp _ _) = "multicoretemp" + alias K10Temp {} = "k10temp" alias DiskU {} = "disku" alias DiskIO {} = "diskio" alias (Uptime _ _) = "uptime" @@ -148,6 +156,7 @@ instance Exec Monitors where #ifdef LIBMPD alias (MPD _ _) = "mpd" alias (AutoMPD _) = "autompd" + alias (MPDX _ _ a) = a #endif #ifdef ALSA alias (Volume m c _ _) = m ++ ":" ++ c @@ -170,6 +179,7 @@ instance Exec Monitors where 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 @@ -179,6 +189,7 @@ instance Exec Monitors where 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 @@ -191,6 +202,7 @@ instance Exec Monitors where #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 diff -pruN 0.36-2/src/Xmobar/Plugins/NotmuchMail.hs 0.46-1/src/Xmobar/Plugins/NotmuchMail.hs --- 0.36-2/src/Xmobar/Plugins/NotmuchMail.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/NotmuchMail.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,109 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/Plugins/QueueReader.hs 0.46-1/src/Xmobar/Plugins/QueueReader.hs --- 0.36-2/src/Xmobar/Plugins/QueueReader.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/QueueReader.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,50 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/Plugins/StdinReader.hs 0.46-1/src/Xmobar/Plugins/StdinReader.hs --- 0.36-2/src/Xmobar/Plugins/StdinReader.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/StdinReader.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,3 +1,5 @@ +{-# LANGUAGE ViewPatterns #-} + ----------------------------------------------------------------------------- -- | -- Module : Plugins.StdinReader @@ -22,30 +24,31 @@ import Prelude import System.Posix.Process import System.Exit import System.IO +import System.IO.Error (isEOFError) import Xmobar.Run.Exec -import Xmobar.X11.Actions (stripActions) -import Xmobar.System.Utils (onSomeException) -import Control.Monad (when) +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 = do - -- The EOF check is necessary for certain systems - -- More details here https://github.com/jaor/xmobar/issues/442 - eof <- isEOF - when eof $ - do hPrint stderr "xmobar: eof at an early stage" - exitImmediately ExitSuccess - s <- - getLine `onSomeException` - (\e -> do - let errorMessage = "xmobar: Received exception " <> show e - hPrint stderr errorMessage - cb errorMessage) - cb $ escape stdinReader s - start stdinReader cb + 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 diff -pruN 0.36-2/src/Xmobar/Plugins/XMonadLog.hs 0.46-1/src/Xmobar/Plugins/XMonadLog.hs --- 0.36-2/src/Xmobar/Plugins/XMonadLog.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Plugins/XMonadLog.hs 2001-09-09 01:46:40.000000000 +0000 @@ -21,14 +21,12 @@ import Control.Monad import Graphics.X11 import Graphics.X11.Xlib.Extras import Xmobar.Run.Exec -#ifdef UTF8 -#undef UTF8 +import Xmobar.Run.Actions (stripActions) + import Codec.Binary.UTF8.String as UTF8 -#define UTF8 -#endif import Foreign.C (CChar) +import Data.List (intercalate) import Xmobar.X11.Events (nextEvent') -import Xmobar.X11.Actions (stripActions) data XMonadLog = XMonadLog | UnsafeXMonadLog @@ -54,11 +52,12 @@ instance Exec XMonadLog where UnsafeXPropertyLog a -> a NamedXPropertyLog a _ -> a UnsafeNamedXPropertyLog a _ -> a + stripNL = intercalate " - " . lines sanitize = case x of UnsafeXMonadLog -> id UnsafeXPropertyLog _ -> id UnsafeNamedXPropertyLog _ _ -> id - _ -> stripActions + _ -> stripActions . stripNL d <- openDisplay "" xlog <- internAtom d atom False @@ -82,10 +81,4 @@ instance Exec XMonadLog where return () decodeCChar :: [CChar] -> String -#ifdef UTF8 -#undef UTF8 decodeCChar = UTF8.decode . map fromIntegral -#define UTF8 -#else -decodeCChar = map (toEnum . fromIntegral) -#endif diff -pruN 0.36-2/src/Xmobar/Run/Actions.hs 0.46-1/src/Xmobar/Run/Actions.hs --- 0.36-2/src/Xmobar/Run/Actions.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Actions.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,43 @@ +----------------------------------------------------------------------------- +-- | +-- 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>" diff -pruN 0.36-2/src/Xmobar/Run/Command.hs 0.46-1/src/Xmobar/Run/Command.hs --- 0.36-2/src/Xmobar/Run/Command.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Command.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,54 +0,0 @@ ------------------------------------------------------------------------------- --- | --- Module: Xmobar.Plugins.Command --- 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 05:29 --- --- --- The basic Command plugin --- ------------------------------------------------------------------------------- - - -module Xmobar.Run.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 diff -pruN 0.36-2/src/Xmobar/Run/Exec.hs 0.46-1/src/Xmobar/Run/Exec.hs --- 0.36-2/src/Xmobar/Run/Exec.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Exec.hs 2001-09-09 01:46:40.000000000 +0000 @@ -22,7 +22,7 @@ module Xmobar.Run.Exec (Exec (..), tenth import Prelude import Data.Char -import Xmobar.App.Timer (doEveryTenthSeconds, tenthSeconds) +import Xmobar.Run.Timer (doEveryTenthSeconds, tenthSeconds) import Xmobar.System.Signal class Show e => Exec e where diff -pruN 0.36-2/src/Xmobar/Run/Loop.hs 0.46-1/src/Xmobar/Run/Loop.hs --- 0.36-2/src/Xmobar/Run/Loop.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Loop.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,126 @@ +{-# 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) diff -pruN 0.36-2/src/Xmobar/Run/Runnable.hs 0.46-1/src/Xmobar/Run/Runnable.hs --- 0.36-2/src/Xmobar/Run/Runnable.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Runnable.hs 2001-09-09 01:46:40.000000000 +0000 @@ -34,7 +34,7 @@ instance Exec Runnable where trigger (Run a) = trigger a instance Show Runnable where - show (Run x) = show x + show (Run x) = "Run " ++ show x instance Read Runnable where readPrec = readRunnable diff -pruN 0.36-2/src/Xmobar/Run/Runnable.hs-boot 0.46-1/src/Xmobar/Run/Runnable.hs-boot --- 0.36-2/src/Xmobar/Run/Runnable.hs-boot 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Runnable.hs-boot 2001-09-09 01:46:40.000000000 +0000 @@ -4,5 +4,6 @@ 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 diff -pruN 0.36-2/src/Xmobar/Run/Template.hs 0.46-1/src/Xmobar/Run/Template.hs --- 0.36-2/src/Xmobar/Run/Template.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Template.hs 2001-09-09 01:46:40.000000000 +0000 @@ -20,8 +20,9 @@ module Xmobar.Run.Template(parseTemplate import qualified Data.Map as Map import Text.ParserCombinators.Parsec +import Xmobar.Plugins.Command + import Xmobar.Run.Exec -import Xmobar.Run.Command import Xmobar.Run.Runnable defaultAlign :: String diff -pruN 0.36-2/src/Xmobar/Run/Timer.hs 0.46-1/src/Xmobar/Run/Timer.hs --- 0.36-2/src/Xmobar/Run/Timer.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Timer.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,221 @@ +{-# 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' diff -pruN 0.36-2/src/Xmobar/Run/Types.hs 0.46-1/src/Xmobar/Run/Types.hs --- 0.36-2/src/Xmobar/Run/Types.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/Run/Types.hs 2001-09-09 01:46:40.000000000 +0000 @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Run.Types --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -19,6 +19,7 @@ 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 @@ -30,6 +31,7 @@ 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 @@ -40,7 +42,9 @@ import Xmobar.Plugins.MBox import Xmobar.Plugins.DateZone #endif -import Xmobar.Run.Command +#ifdef KRAKEN +import Xmobar.Plugins.Kraken +#endif -- | An alias for tuple types that is more convenient for long lists. type a :*: b = (a, b) @@ -54,12 +58,15 @@ infixr :*: -- this function's type signature. runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: - XMonadLog :*: EWMH :*: Kbd :*: Locks :*: + XMonadLog :*: EWMH :*: Kbd :*: Locks :*: NotmuchMail :*: #ifdef INOTIFY Mail :*: MBox :*: #endif #ifdef DATEZONE DateZone :*: #endif +#ifdef KRAKEN + Kraken :*: +#endif MarqueePipeReader :*: () runnableTypes = undefined diff -pruN 0.36-2/src/Xmobar/System/Environment.hs 0.46-1/src/Xmobar/System/Environment.hs --- 0.36-2/src/Xmobar/System/Environment.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/System/Environment.hs 2001-09-09 01:46:40.000000000 +0000 @@ -13,14 +13,14 @@ ----------------------------------------------------------------------------- module Xmobar.System.Environment(expandEnv) where -import Data.Maybe (fromMaybe) -import System.Environment (lookupEnv) +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 <- fromMaybe "" <$> lookupEnv e + envVar <- M.fromMaybe "" <$> E.lookupEnv e remainder <- expandEnv s' return $ envVar ++ remainder where (e, s') = getVar s diff -pruN 0.36-2/src/Xmobar/System/Kbd.hsc 0.46-1/src/Xmobar/System/Kbd.hsc --- 0.36-2/src/Xmobar/System/Kbd.hsc 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/System/Kbd.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -15,11 +15,14 @@ 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> @@ -113,9 +116,9 @@ data XkbNamesRec = XkbNamesRec { symbols :: Atom, types :: Atom, compat :: Atom, - vmods :: Ptr Atom, - indicators :: Ptr Atom, -- array - groups :: Ptr Atom, -- array + 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, @@ -178,9 +181,9 @@ instance Storable XkbNamesRec where r_symbols <- (#peek XkbNamesRec, symbols ) ptr r_types <- (#peek XkbNamesRec, types ) ptr r_compat <- (#peek XkbNamesRec, compat ) ptr - r_vmods <- (#peek XkbNamesRec, vmods ) ptr - r_indicators <- (#peek XkbNamesRec, indicators ) ptr - r_groups <- (#peek XkbNamesRec, groups ) 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 @@ -303,7 +306,7 @@ getLayoutStr dpy = do kbdDescPtr <- xkbAllocKeyboard status <- xkbGetNames dpy xkbSymbolsNameMask kbdDescPtr str <- getLayoutStr' status dpy kbdDescPtr - xkbFreeNames kbdDescPtr xkbGroupNamesMask 1 + xkbFreeNames kbdDescPtr xkbSymbolsNameMask 1 xkbFreeKeyboard kbdDescPtr 0 1 return str @@ -319,3 +322,23 @@ getLayoutStr' st dpy kbdDescPtr = 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!"] diff -pruN 0.36-2/src/Xmobar/System/Localize.hsc 0.46-1/src/Xmobar/System/Localize.hsc --- 0.36-2/src/Xmobar/System/Localize.hsc 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/System/Localize.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -25,9 +25,7 @@ import qualified System.Locale as L import qualified Data.Time.Format as L #endif -#ifdef UTF8 import Codec.Binary.UTF8.String -#endif -- get localized strings type NlItem = CInt @@ -48,12 +46,8 @@ foreign import ccall unsafe "langinfo.h getLangInfo :: NlItem -> IO String getLangInfo item = do itemStr <- nl_langinfo item -#ifdef UTF8 str <- peekCString itemStr return $ if isUTF8Encoded str then decodeString str else str -#else - peekCString itemStr -#endif #include <locale.h> foreign import ccall unsafe "locale.h setlocale" diff -pruN 0.36-2/src/Xmobar/System/Signal.hs 0.46-1/src/Xmobar/System/Signal.hs --- 0.36-2/src/Xmobar/System/Signal.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/System/Signal.hs 2001-09-09 01:46:40.000000000 +0000 @@ -46,6 +46,7 @@ data SignalType = Wakeup | Hide Int | Reveal Int | Toggle Int + | SetAlpha Int | TogglePersistent | Action Button Position deriving (Read, Show) @@ -60,12 +61,11 @@ parseSignalType :: String -> Maybe Signa parseSignalType = fmap fst . safeHead . reads -- | Signal handling -setupSignalHandler :: IO (TMVar SignalType) -setupSignalHandler = do - tid <- newEmptyTMVarIO +setupSignalHandler :: TMVar SignalType -> IO () +setupSignalHandler tid = do installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing - return tid + return () updatePosHandler :: TMVar SignalType -> IO () updatePosHandler sig = do diff -pruN 0.36-2/src/Xmobar/System/Utils.hs 0.46-1/src/Xmobar/System/Utils.hs --- 0.36-2/src/Xmobar/System/Utils.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/System/Utils.hs 2001-09-09 01:46:40.000000000 +0000 @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Utils --- Copyright: (c) 2010, 2018, 2020 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2010, 2018, 2020, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: Jose A Ortega Ruiz <jao@gnu.org> @@ -20,23 +20,42 @@ module Xmobar.System.Utils ( expandHome , changeLoop - , onSomeException , 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 -import Control.Exception 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 @@ -47,15 +66,6 @@ changeLoop s f = atomically s >>= go guard (new /= old) return new) --- | Like 'finally', but only performs the final action if there was an --- exception raised by the computation. --- --- Note that this implementation is a slight modification of --- onException function. -onSomeException :: IO a -> (SomeException -> IO b) -> IO a -onSomeException io what = io `catch` \e -> do _ <- what e - throwIO (e :: SomeException) - (!!?) :: [a] -> Int -> Maybe a (!!?) xs i | i < 0 = Nothing diff -pruN 0.36-2/src/Xmobar/Text/Ansi.hs 0.46-1/src/Xmobar/Text/Ansi.hs --- 0.36-2/src/Xmobar/Text/Ansi.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Text/Ansi.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,49 @@ +------------------------------------------------------------------------------ +-- | +-- 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" diff -pruN 0.36-2/src/Xmobar/Text/Loop.hs 0.46-1/src/Xmobar/Text/Loop.hs --- 0.36-2/src/Xmobar/Text/Loop.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Text/Loop.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,48 @@ +------------------------------------------------------------------------------ +-- | +-- 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) diff -pruN 0.36-2/src/Xmobar/Text/Output.hs 0.46-1/src/Xmobar/Text/Output.hs --- 0.36-2/src/Xmobar/Text/Output.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Text/Output.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,57 @@ +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar/Text/Pango.hs 0.46-1/src/Xmobar/Text/Pango.hs --- 0.36-2/src/Xmobar/Text/Pango.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Text/Pango.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,50 @@ +------------------------------------------------------------------------------ +-- | +-- 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>" diff -pruN 0.36-2/src/Xmobar/Text/SwaybarClicks.hs 0.46-1/src/Xmobar/Text/SwaybarClicks.hs --- 0.36-2/src/Xmobar/Text/SwaybarClicks.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Text/SwaybarClicks.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,57 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/Text/Swaybar.hs 0.46-1/src/Xmobar/Text/Swaybar.hs --- 0.36-2/src/Xmobar/Text/Swaybar.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/Text/Swaybar.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,147 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/X11/Actions.hs 0.46-1/src/Xmobar/X11/Actions.hs --- 0.36-2/src/Xmobar/X11/Actions.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Actions.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,34 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Xmobar.Actions --- Copyright : (c) Alexander Polakov --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- ------------------------------------------------------------------------------ - -module Xmobar.X11.Actions (Action(..), runAction, stripActions) where - -import System.Process (system) -import Control.Monad (void) -import Text.Regex (Regex, subRegex, mkRegex, matchRegex) -import Graphics.X11.Types (Button) - -data Action = Spawn [Button] String - deriving (Eq) - -runAction :: Action -> IO () -runAction (Spawn _ s) = void $ system (s ++ "&") - -stripActions :: String -> String -stripActions s = case matchRegex actionRegex s of - Nothing -> s - Just _ -> stripActions strippedOneLevel - where - strippedOneLevel = subRegex actionRegex s "[action=\\1\\2]\\3[/action]" - -actionRegex :: Regex -actionRegex = mkRegex "<action=`?([^>`]*)`?( +button=[12345]+)?>(.+)</action>" diff -pruN 0.36-2/src/Xmobar/X11/Bitmap.hs 0.46-1/src/Xmobar/X11/Bitmap.hs --- 0.36-2/src/Xmobar/X11/Bitmap.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Bitmap.hs 2001-09-09 01:46:40.000000000 +0000 @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : X11.Bitmap --- Copyright : (C) 2013, 2015, 2017, 2018 Alexander Polakov +-- Copyright : (C) 2013, 2015, 2017, 2018, 2022 Alexander Polakov -- License : BSD3 -- -- Maintainer : jao@gnu.org @@ -14,18 +14,20 @@ module Xmobar.X11.Bitmap ( updateCache , drawBitmap - , Bitmap(..)) where + , Bitmap(..) + , BitmapCache) where import Control.Monad import Control.Monad.Trans(MonadIO(..)) -import Data.Map hiding (map, filter) -import Graphics.X11.Xlib +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 -import Xmobar.X11.Parsers (TextRenderInfo(..), Widget(..)) -import Xmobar.X11.Actions (Action) #ifdef XPM import Xmobar.X11.XPMFile(readXPMFile) @@ -53,13 +55,12 @@ data Bitmap = Bitmap { width :: Dimensi , bitmapType :: BitmapType } -updateCache :: Display -> Window -> Map FilePath Bitmap -> FilePath -> - [[(Widget, TextRenderInfo, Int, Maybe [Action])]] -> IO (Map FilePath Bitmap) -updateCache dpy win cache iconRoot ps = do - let paths = map (\(Icon p, _, _, _) -> p) . concatMap (filter icons) $ ps - icons (Icon _, _, _, _) = True - icons _ = False - expandPath path@('/':_) = path +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 @@ -115,7 +116,7 @@ loadBitmap d w p = do 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 + withColors d [fc, bc] $ \[fc', bc'] -> do let w = width i h = height i y' = 1 + y - fromIntegral h `div` 2 diff -pruN 0.36-2/src/Xmobar/X11/CairoSurface.hsc 0.46-1/src/Xmobar/X11/CairoSurface.hsc --- 0.36-2/src/Xmobar/X11/CairoSurface.hsc 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/CairoSurface.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,69 @@ +{-# 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) diff -pruN 0.36-2/src/Xmobar/X11/ColorCache.hs 0.46-1/src/Xmobar/X11/ColorCache.hs --- 0.36-2/src/Xmobar/X11/ColorCache.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/ColorCache.hs 2001-09-09 01:46:40.000000000 +0000 @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: ColorCache --- Copyright: (c) 2012 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2012, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -15,97 +15,47 @@ -- ------------------------------------------------------------------------------ -#if defined XFT - -module Xmobar.X11.ColorCache(withColors, withDrawingColors) where - -import Xmobar.X11.MinXft - -#else - module Xmobar.X11.ColorCache(withColors) where -#endif +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 Data.IORef -import System.IO.Unsafe (unsafePerformIO) -import Control.Monad.Trans (MonadIO, liftIO) -import Control.Exception (SomeException, handle) -import Graphics.X11.Xlib +import qualified Graphics.X11.Xlib as X -data DynPixel = DynPixel Bool Pixel +data DynPixel = DynPixel Bool X.Pixel -initColor :: Display -> String -> IO DynPixel -initColor dpy c = handle black $ initColor' dpy c +initColor :: X.Display -> String -> IO DynPixel +initColor dpy c = E.handle black $ initColor' dpy c where - black :: SomeException -> IO DynPixel - black = const . return $ DynPixel False (blackPixel dpy $ defaultScreen dpy) + black :: E.SomeException -> IO DynPixel + black = const . return $ DynPixel False (X.blackPixel dpy $ X.defaultScreen dpy) -type ColorCache = [(String, Color)] +type ColorCache = [(String, X.Color)] {-# NOINLINE colorCache #-} -colorCache :: IORef ColorCache -colorCache = unsafePerformIO $ newIORef [] +colorCache :: IO.IORef ColorCache +colorCache = U.unsafePerformIO $ IO.newIORef [] -getCachedColor :: String -> IO (Maybe Color) -getCachedColor color_name = lookup color_name `fmap` readIORef colorCache +getCachedColor :: String -> IO (Maybe X.Color) +getCachedColor color_name = lookup color_name `fmap` IO.readIORef colorCache -putCachedColor :: String -> Color -> IO () -putCachedColor name c_id = modifyIORef colorCache $ \c -> (name, c_id) : c +putCachedColor :: String -> X.Color -> IO () +putCachedColor name c_id = IO.modifyIORef colorCache $ \c -> (name, c_id) : c -initColor' :: Display -> String -> IO DynPixel +initColor' :: X.Display -> String -> IO DynPixel initColor' dpy c = do - let colormap = defaultColormap dpy (defaultScreen dpy) + let colormap = X.defaultColormap dpy (X.defaultScreen dpy) cached_color <- getCachedColor c c' <- case cached_color of Just col -> return col - _ -> do (c'', _) <- allocNamedColor dpy colormap c + _ -> do (c'', _) <- X.allocNamedColor dpy colormap c putCachedColor c c'' return c'' - return $ DynPixel True (color_pixel c') + return $ DynPixel True (X.color_pixel c') -withColors :: MonadIO m => Display -> [String] -> ([Pixel] -> m a) -> m a +withColors :: Tr.MonadIO m => X.Display -> [String] -> ([X.Pixel] -> m a) -> m a withColors d cs f = do - ps <- mapM (liftIO . initColor d) cs + ps <- mapM (Tr.liftIO . initColor d) cs f $ map (\(DynPixel _ pixel) -> pixel) ps - -#ifdef XFT - -type AXftColorCache = [(String, AXftColor)] -{-# NOINLINE xftColorCache #-} -xftColorCache :: IORef AXftColorCache -xftColorCache = unsafePerformIO $ newIORef [] - -getXftCachedColor :: String -> IO (Maybe AXftColor) -getXftCachedColor name = lookup name `fmap` readIORef xftColorCache - -putXftCachedColor :: String -> AXftColor -> IO () -putXftCachedColor name cptr = - modifyIORef xftColorCache $ \c -> (name, cptr) : c - -initAXftColor' :: Display -> Visual -> Colormap -> String -> IO AXftColor -initAXftColor' d v cm c = do - cc <- getXftCachedColor c - c' <- case cc of - Just col -> return col - _ -> do c'' <- mallocAXftColor d v cm c - putXftCachedColor c c'' - return c'' - return c' - -initAXftColor :: Display -> Visual -> Colormap -> String -> IO AXftColor -initAXftColor d v cm c = handle black $ (initAXftColor' d v cm c) - where - black :: SomeException -> IO AXftColor - black = (const $ initAXftColor' d v cm "black") - -withDrawingColors :: -- MonadIO m => - Display -> Drawable -> String -> String - -> (AXftDraw -> AXftColor -> AXftColor -> IO ()) -> IO () -withDrawingColors dpy drw fc bc f = do - let screen = defaultScreenOfDisplay dpy - colormap = defaultColormapOfScreen screen - visual = defaultVisualOfScreen screen - fc' <- initAXftColor dpy visual colormap fc - bc' <- initAXftColor dpy visual colormap bc - withAXftDraw dpy drw visual colormap $ \draw -> f draw fc' bc' -#endif diff -pruN 0.36-2/src/Xmobar/X11/Draw.hs 0.46-1/src/Xmobar/X11/Draw.hs --- 0.36-2/src/Xmobar/X11/Draw.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Draw.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,209 +1,91 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE TupleSections #-} - ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Draw --- Copyright: (c) 2018, 2020 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org -- Stability: unstable --- Portability: portable --- Created: Sat Nov 24, 2018 18:49 +-- Portability: unportable +-- Created: Fri Sep 09, 2022 02:03 -- +-- Drawing the xmobar contents using Cairo and Pango -- --- Drawing the xmobar contents -- ------------------------------------------------------------------------------ +module Xmobar.X11.Draw (draw) where -module Xmobar.X11.Draw (drawInWin) where - -import Prelude hiding (lookup) -import Control.Monad.IO.Class -import Control.Monad.Reader -import Control.Arrow ((&&&)) -import Data.Map hiding ((\\), foldr, map, filter) -import Data.List ((\\)) -import qualified Data.List.NonEmpty as NE +import qualified Data.Map as M -import Graphics.X11.Xlib hiding (textExtents, textWidth) -import Graphics.X11.Xlib.Extras +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 Xmobar.Config.Types import qualified Xmobar.X11.Bitmap as B -import Xmobar.X11.Actions (Action(..)) -import Xmobar.X11.Types -import Xmobar.X11.Text -import Xmobar.X11.ColorCache -import Xmobar.X11.Window (drawBorder) -import Xmobar.X11.Parsers hiding (parseString) -import Xmobar.System.Utils (safeIndex) - -#ifdef XFT -import Xmobar.X11.MinXft -import Graphics.X11.Xrender -#endif +import qualified Xmobar.X11.Types as T +import qualified Xmobar.X11.CairoSurface as CS -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral - --- | Draws in and updates the window -drawInWin :: Rectangle -> [[(Widget, TextRenderInfo, Int, Maybe [Action])]] -> X () -drawInWin wr@(Rectangle _ _ wid ht) ~[left,center,right] = do - r <- ask - let (c,d) = (config &&& display) r - (w,(fs,vs)) = (window &&& fontListS &&& verticalOffsets) r - strLn = liftIO . mapM getWidth - iconW i = maybe 0 B.width (lookup i $ iconS r) - getWidth (Text s,cl,i,_) = - textWidth d (safeIndex fs i) s >>= \tw -> return (Text s,cl,i,fi tw) - getWidth (Icon s,cl,i,_) = return (Icon s,cl,i,fi $ iconW s) - - p <- liftIO $ createPixmap d w wid ht - (defaultDepthOfScreen (defaultScreenOfDisplay d)) -#if XFT - when (alpha c /= 255) (liftIO $ drawBackground d p (bgColor c) (alpha c) wr) -#else - _ <- return wr -#endif - withColors d [bgColor c, borderColor c] $ \[bgcolor, bdcolor] -> do - gc <- liftIO $ createGC d w -#if XFT - when (alpha c == 255) $ do -#else - do +#ifdef XRENDER +import qualified Xmobar.X11.XRender as XRender #endif - liftIO $ setForeground d gc bgcolor - liftIO $ fillRectangle d p gc 0 0 wid ht - -- write to the pixmap the new string - printStrings p gc fs vs 1 L [] =<< strLn left - printStrings p gc fs vs 1 R [] =<< strLn right - printStrings p gc fs vs 1 C [] =<< strLn center - -- draw border if requested - liftIO $ drawBorder (border c) (borderWidth c) d p gc bdcolor wid ht - -- copy the pixmap with the new string to the window - liftIO $ copyArea d p w gc 0 0 wid ht 0 0 - -- free up everything (we do not want to leak memory!) - liftIO $ freeGC d gc - liftIO $ freePixmap d p - -- resync - liftIO $ sync d True - -verticalOffset :: (Integral b, Integral a, MonadIO m) => - a -> Widget -> XFont -> Int -> Config -> m b -verticalOffset ht (Text t) fontst voffs _ - | voffs > -1 = return $ fi voffs - | otherwise = do - (as,ds) <- liftIO $ textExtents fontst t - let margin = (fi ht - fi ds - fi as) `div` 2 - return $ fi as + margin - 1 -verticalOffset ht (Icon _) _ _ conf - | iconOffset conf > -1 = return $ fi (iconOffset conf) - | otherwise = return $ fi (ht `div` 2) - 1 - -printString :: Display -> Drawable -> XFont -> GC -> String -> String - -> Position -> Position -> Position -> Position -> String -> Int -> IO () -printString d p (Core fs) gc fc bc x y _ _ s a = do - setFont d gc $ fontFromFontStruct fs - withColors d [fc, bc] $ \[fc', bc'] -> do - setForeground d gc fc' - when (a == 255) (setBackground d gc bc') - drawImageString d p gc x y s - -printString d p (Utf8 fs) gc fc bc x y _ _ s a = - withColors d [fc, bc] $ \[fc', bc'] -> do - setForeground d gc fc' - when (a == 255) (setBackground d gc bc') - liftIO $ wcDrawImageString d p fs gc x y s - -#ifdef XFT -printString dpy drw fs@(Xft fonts) _ fc bc x y ay ht s al = - withDrawingColors dpy drw fc bc $ \draw fc' bc' -> do - when (al == 255) $ do - (a,d) <- textExtents fs s - gi <- xftTxtExtents' dpy fonts s - if ay < 0 - then drawXftRect draw bc' x (y - a) (1 + xglyphinfo_xOff gi) (a + d + 2) - else drawXftRect draw bc' x ay (1 + xglyphinfo_xOff gi) ht - drawXftString' draw fc' fonts (toInteger x) (toInteger y) s + +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 --- | An easy way to print the stuff we need to print -printStrings :: Drawable -> GC -> NE.NonEmpty XFont -> [Int] -> Position - -> Align -> [((Position, Position), Box)] -> [(Widget, TextRenderInfo, Int, Position)] -> X () -printStrings _ _ _ _ _ _ _ [] = return () -printStrings dr gc fontlist voffs offs a boxes sl@((s,c,i,l):xs) = do - r <- ask - let (conf,d) = (config &&& display) r - alph = alpha conf - Rectangle _ _ wid ht = rect r - totSLen = foldr (\(_,_,_,len) -> (+) len) 0 sl - remWidth = fi wid - fi totSLen - fontst = safeIndex fontlist i - offset = case a of - C -> (remWidth + offs) `div` 2 - R -> remWidth - L -> offs - (fc,bc) = case break (==',') (tColorsString c) of - (f,',':b) -> (f, b ) - (f, _) -> (f, bgColor conf) - valign <- verticalOffset ht s (NE.head fontlist) (voffs !! i) conf - let (ht',ay) = case (tBgTopOffset c, tBgBottomOffset c) of - (-1,_) -> (0, -1) - (_,-1) -> (0, -1) - (ot,ob) -> (fromIntegral ht - ot - ob, ob) - case s of - (Text t) -> liftIO $ printString d dr fontst gc fc bc offset valign ay ht' t alph - (Icon p) -> liftIO $ maybe (return ()) - (B.drawBitmap d dr gc fc bc offset valign) - (lookup p (iconS r)) - let triBoxes = tBoxes c - dropBoxes = filter (\(_,b) -> b `notElem` triBoxes) boxes - boxes' = map (\((x1,_),b) -> ((x1, offset + l), b)) (filter (\(_,b) -> b `elem` triBoxes) boxes) - ++ map ((offset, offset + l),) (triBoxes \\ map snd boxes) - if Prelude.null xs - then liftIO $ drawBoxes d dr gc (fromIntegral ht) (dropBoxes ++ boxes') - else liftIO $ drawBoxes d dr gc (fromIntegral ht) dropBoxes - printStrings dr gc fontlist voffs (offs + l) a boxes' xs - -drawBoxes :: Display -> Drawable -> GC -> Position -> [((Position, Position), Box)] -> IO () -drawBoxes _ _ _ _ [] = return () -drawBoxes d dr gc ht (b:bs) = do - let (xx, Box bb offset lineWidth fc mgs) = b - lw = fromIntegral lineWidth :: Position - withColors d [fc] $ \[fc'] -> do - setForeground d gc fc' - setLineAttributes d gc lineWidth lineSolid capNotLast joinMiter - case bb of - BBVBoth -> do - drawBoxBorder d dr gc BBTop offset ht xx lw mgs - drawBoxBorder d dr gc BBBottom offset ht xx lw mgs - BBHBoth -> do - drawBoxBorder d dr gc BBLeft offset ht xx lw mgs - drawBoxBorder d dr gc BBRight offset ht xx lw mgs - BBFull -> do - drawBoxBorder d dr gc BBTop offset ht xx lw mgs - drawBoxBorder d dr gc BBBottom offset ht xx lw mgs - drawBoxBorder d dr gc BBLeft offset ht xx lw mgs - drawBoxBorder d dr gc BBRight offset ht xx lw mgs - _ -> drawBoxBorder d dr gc bb offset ht xx lw mgs - drawBoxes d dr gc ht bs - -drawBoxBorder :: Display -> Drawable -> GC -> BoxBorder -> BoxOffset -> Position - -> (Position, Position) -> Position -> BoxMargins -> IO () -drawBoxBorder d dr gc pos (BoxOffset alg offset) ht (x1,x2) lw (BoxMargins mt mr mb ml) = do - let (p1,p2) = case alg of - L -> (0, -offset) - C -> (offset, -offset) - R -> (offset, 0 ) - lc = lw `div` 2 - case pos of - BBTop -> drawLine d dr gc (x1 + p1) (mt + lc) (x2 + p2) (mt + lc) - BBBottom -> do - let lc' = max lc 1 + mb - drawLine d dr gc (x1 + p1) (ht - lc') (x2 + p2) (ht - lc') - BBLeft -> drawLine d dr gc (x1 - 1 + ml) p1 (x1 - 1 + ml) (ht + p2) - BBRight -> drawLine d dr gc (x2 + lc - 1 - mr) p1 (x2 + lc - 1 - mr) (ht + p2) - _ -> error "unreachable code" + CS.withXlibSurface disp p vis (fromIntegral w) (fromIntegral h) render diff -pruN 0.36-2/src/Xmobar/X11/Events.hs 0.46-1/src/Xmobar/X11/Events.hs --- 0.36-2/src/Xmobar/X11/Events.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Events.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Events --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -17,20 +17,19 @@ module Xmobar.X11.Events(nextEvent') where -import Control.Concurrent -import System.Posix.Types (Fd(..)) +import qualified Control.Concurrent as C +import qualified System.Posix.Types as T -import Graphics.X11.Xlib ( - Display(..), XEventPtr, nextEvent, pending, connectionNumber) +import qualified Graphics.X11.Xlib as X -- | A version of nextEvent that does not block in foreign calls. -nextEvent' :: Display -> XEventPtr -> IO () +nextEvent' :: X.Display -> X.XEventPtr -> IO () nextEvent' d p = do - pend <- pending d + pend <- X.pending d if pend /= 0 - then nextEvent d p + then X.nextEvent d p else do - threadWaitRead (Fd fd) + C.threadWaitRead (T.Fd fd) nextEvent' d p where - fd = connectionNumber d + fd = X.connectionNumber d diff -pruN 0.36-2/src/Xmobar/X11/Loop.hs 0.46-1/src/Xmobar/X11/Loop.hs --- 0.36-2/src/Xmobar/X11/Loop.hs 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Loop.hs 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,176 @@ +{-# 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 diff -pruN 0.36-2/src/Xmobar/X11/MinXft.hsc 0.46-1/src/Xmobar/X11/MinXft.hsc --- 0.36-2/src/Xmobar/X11/MinXft.hsc 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/MinXft.hsc 1970-01-01 00:00:00.000000000 +0000 @@ -1,339 +0,0 @@ ------------------------------------------------------------------------------- --- | --- Module: MinXft --- Copyright: (c) 2012, 2014, 2015, 2017 Jose Antonio Ortega Ruiz --- (c) Clemens Fruhwirth <clemens@endorphin.org> 2007 --- License: BSD3-style (see LICENSE) --- --- Maintainer: jao@gnu.org --- Stability: unstable --- Portability: unportable --- Created: Mon Sep 10, 2012 18:12 --- --- --- Pared down Xft library, based on Graphics.X11.Xft and providing --- explicit management of XftColors, so that they can be cached. --- --- Most of the code is lifted from Clemens's. --- ------------------------------------------------------------------------------- - -{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-} - -module Xmobar.X11.MinXft ( AXftColor - , AXftDraw (..) - , AXftFont - , mallocAXftColor - , freeAXftColor - , withAXftDraw - , drawXftString - , drawXftString' - , drawBackground - , drawXftRect - , openAXftFont - , closeAXftFont - , xftTxtExtents - , xftTxtExtents' - , xft_ascent - , xft_ascent' - , xft_descent - , xft_descent' - , xft_height - , xft_height' - ) - -where - -import Graphics.X11 -import Graphics.X11.Xlib.Types -import Graphics.X11.Xrender -import Graphics.X11.Xlib.Extras (xGetWindowProperty, xFree) - -import Foreign -import Foreign.C.Types -import Foreign.C.String -import Codec.Binary.UTF8.String as UTF8 -import Data.Char (ord) - -import Control.Monad (when) - -#include <X11/Xft/Xft.h> - --- Color Handling - -newtype AXftColor = AXftColor (Ptr AXftColor) - -foreign import ccall "XftColorAllocName" - cXftColorAllocName :: Display -> Visual -> Colormap -> CString -> AXftColor -> IO (#type Bool) - --- this is the missing bit in X11.Xft, not implementable from the --- outside because XftColor does not export a constructor. -mallocAXftColor :: Display -> Visual -> Colormap -> String -> IO AXftColor -mallocAXftColor d v cm n = do - color <- mallocBytes (#size XftColor) - withCAString n $ \str -> cXftColorAllocName d v cm str (AXftColor color) - return (AXftColor color) - -foreign import ccall "XftColorFree" - freeAXftColor :: Display -> Visual -> Colormap -> AXftColor -> IO () - --- Font handling - -newtype AXftFont = AXftFont (Ptr AXftFont) - -xft_ascent :: AXftFont -> IO Int -xft_ascent (AXftFont p) = peekCUShort p #{offset XftFont, ascent} - -xft_ascent' :: [AXftFont] -> IO Int -xft_ascent' = (fmap maximum) . (mapM xft_ascent) - -xft_descent :: AXftFont -> IO Int -xft_descent (AXftFont p) = peekCUShort p #{offset XftFont, descent} - -xft_descent' :: [AXftFont] -> IO Int -xft_descent' = (fmap maximum) . (mapM xft_descent) - -xft_height :: AXftFont -> IO Int -xft_height (AXftFont p) = peekCUShort p #{offset XftFont, height} - -xft_height' :: [AXftFont] -> IO Int -xft_height' = (fmap maximum) . (mapM xft_height) - -foreign import ccall "XftTextExtentsUtf8" - cXftTextExtentsUtf8 :: Display -> AXftFont -> CString -> CInt -> Ptr XGlyphInfo -> IO () - -xftTxtExtents :: Display -> AXftFont -> String -> IO XGlyphInfo -xftTxtExtents d f string = - withArrayLen (map fi (UTF8.encode string)) $ - \len str_ptr -> alloca $ - \cglyph -> do - cXftTextExtentsUtf8 d f str_ptr (fi len) cglyph - peek cglyph - -xftTxtExtents' :: Display -> [AXftFont] -> String -> IO XGlyphInfo -xftTxtExtents' d fs string = do - chunks <- getChunks d fs string - let (_, _, gi, _, _) = last chunks - return gi - -foreign import ccall "XftFontOpenName" - c_xftFontOpen :: Display -> CInt -> CString -> IO AXftFont - -openAXftFont :: Display -> Screen -> String -> IO AXftFont -openAXftFont dpy screen name = - withCAString name $ - \cname -> c_xftFontOpen dpy (fi (screenNumberOfScreen screen)) cname - -foreign import ccall "XftFontClose" - closeAXftFont :: Display -> AXftFont -> IO () - -foreign import ccall "XftCharExists" - cXftCharExists :: Display -> AXftFont -> (#type FcChar32) -> IO (#type FcBool) - -xftCharExists :: Display -> AXftFont -> Char -> IO Bool -xftCharExists d f c = bool `fmap` cXftCharExists d f (fi $ ord c) - where - bool 0 = False - bool _ = True --- Drawing - -fi :: (Integral a, Num b) => a -> b -fi = fromIntegral - -newtype AXftDraw = AXftDraw (Ptr AXftDraw) - -foreign import ccall "XftDrawCreate" - c_xftDrawCreate :: Display -> Drawable -> Visual -> Colormap -> IO AXftDraw - -foreign import ccall "XftDrawDisplay" - c_xftDrawDisplay :: AXftDraw -> IO Display - -foreign import ccall "XftDrawDestroy" - c_xftDrawDestroy :: AXftDraw -> IO () - -withAXftDraw :: Display -> Drawable -> Visual -> Colormap -> (AXftDraw -> IO a) -> IO a -withAXftDraw d p v c act = do - draw <- c_xftDrawCreate d p v c - a <- act draw - c_xftDrawDestroy draw - return a - -foreign import ccall "XftDrawStringUtf8" - cXftDrawStringUtf8 :: AXftDraw -> AXftColor -> AXftFont -> CInt -> CInt -> Ptr (#type FcChar8) -> CInt -> IO () - --- Fixes https://github.com/jaor/xmobar/issues/476 -utf8EncodeString :: Num b => String -> [b] -utf8EncodeString str = if UTF8.isUTF8Encoded str - then map (fi . ord) str - else map fi (UTF8.encode str) - -drawXftString :: (Integral a1, Integral a) => - AXftDraw -> AXftColor -> AXftFont -> a -> a1 -> String -> IO () -drawXftString d c f x y string = - withArrayLen (utf8EncodeString string) - (\len ptr -> cXftDrawStringUtf8 d c f (fi x) (fi y) ptr (fi len)) - -drawXftString' :: AXftDraw -> - AXftColor -> - [AXftFont] -> - Integer -> - Integer -> - String -> IO () -drawXftString' d c fs x y string = do - display <- c_xftDrawDisplay d - chunks <- getChunks display fs string - mapM_ (\(f, s, _, xo, yo) -> drawXftString d c f (x+xo) (y+yo) s) chunks - --- Split string and determine fonts/offsets for individual parts -getChunks :: Display -> [AXftFont] -> String -> - IO [(AXftFont, String, XGlyphInfo, Integer, Integer)] -getChunks disp fts str = do - chunks <- getFonts disp fts str - getOffsets (XGlyphInfo 0 0 0 0 0 0) chunks - where - -- Split string and determine fonts for individual parts - getFonts _ [] _ = return [] - getFonts _ _ [] = return [] - getFonts _ [ft] s = return [(ft, s)] - getFonts d fonts@(ft:_) s = do - -- Determine which glyph can be rendered by current font - glyphs <- mapM (xftCharExists d ft) s - -- Split string into parts that can/cannot be rendered - let splits = split (runs glyphs) s - -- Determine which font to render each chunk with - concat `fmap` mapM (getFont d fonts) splits - - -- Determine fonts for substrings - getFont _ [] _ = return [] - getFont _ [ft] (_, s) = return [(ft, s)] -- Last font, use it - getFont _ (ft:_) (True, s) = return [(ft, s)] -- Current font can render this substring - getFont d (_:fs) (False, s) = getFonts d fs s -- Fallback to next font - - -- Helpers - runs [] = [] - runs (x:xs) = let (h, t) = span (==x) xs in (x, length h + 1) : runs t - split [] _ = [] - split ((x, c):xs) s = let (h, t) = splitAt c s in (x, h) : split xs t - - -- Determine coordinates for chunks using extents - getOffsets _ [] = return [] - getOffsets (XGlyphInfo _ _ x y xo yo) ((f, s):chunks) = do - (XGlyphInfo w' h' _ _ xo' yo') <- xftTxtExtents disp f s - let gi = XGlyphInfo (xo+w') (yo+h') x y (xo+xo') (yo+yo') - rest <- getOffsets gi chunks - return $ (f, s, gi, fromIntegral xo, fromIntegral yo) : rest - -foreign import ccall "XftDrawRect" - cXftDrawRect :: AXftDraw -> AXftColor -> CInt -> CInt -> CUInt -> CUInt -> IO () - -drawXftRect :: (Integral a3, Integral a2, Integral a1, Integral a) => - AXftDraw -> AXftColor -> a -> a1 -> a2 -> a3 -> IO () -drawXftRect draw color x y width height = - cXftDrawRect draw color (fi x) (fi y) (fi width) (fi height) - -#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 diff -pruN 0.36-2/src/Xmobar/X11/Parsers.hs 0.46-1/src/Xmobar/X11/Parsers.hs --- 0.36-2/src/Xmobar/X11/Parsers.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Parsers.hs 1970-01-01 00:00:00.000000000 +0000 @@ -1,218 +0,0 @@ -{-# LANGUAGE FlexibleContexts #-} - ------------------------------------------------------------------------------ --- | --- Module : Xmobar.Parsers --- Copyright : (c) Andrea Rossato --- License : BSD-style (see LICENSE) --- --- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> --- Stability : unstable --- Portability : unportable --- --- Parsing for template substrings --- ------------------------------------------------------------------------------ - -module Xmobar.X11.Parsers (parseString, Box(..), BoxBorder(..), BoxOffset(..), - BoxMargins(..), TextRenderInfo(..), Widget(..)) where - -import Xmobar.Config.Types -import Xmobar.X11.Actions - -import Control.Monad (guard, mzero) -import Data.Maybe (fromMaybe) -import Data.Int (Int32) -import Text.ParserCombinators.Parsec -import Text.Read (readMaybe) -import Graphics.X11.Types (Button) -import Foreign.C.Types (CInt) - -data Widget = Icon String | Text String - -data BoxOffset = BoxOffset Align Int32 deriving Eq --- margins: Top, Right, Bottom, Left -data BoxMargins = BoxMargins Int32 Int32 Int32 Int32 deriving Eq -data BoxBorder = BBTop - | BBBottom - | BBVBoth - | BBLeft - | BBRight - | BBHBoth - | BBFull - deriving ( Read, Eq ) -data Box = Box BoxBorder BoxOffset CInt String BoxMargins deriving Eq -data TextRenderInfo = - TextRenderInfo { tColorsString :: String - , tBgTopOffset :: Int32 - , tBgBottomOffset :: Int32 - , tBoxes :: [Box] - } -type FontIndex = Int - --- | Runs the string parser -parseString :: Config -> String - -> IO [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -parseString c s = - case parse (stringParser ci 0 Nothing) "" s of - Left _ -> return [(Text $ "Could not parse string: " ++ s - , ci - , 0 - , Nothing)] - Right x -> return (concat x) - where ci = TextRenderInfo (fgColor c) 0 0 [] - -allParsers :: TextRenderInfo - -> FontIndex - -> Maybe [Action] - -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -allParsers c f a = textParser c f a - <|> try (iconParser c f a) - <|> try (rawParser c f a) - <|> try (actionParser c f a) - <|> try (fontParser c a) - <|> try (boxParser c f a) - <|> colorParser c f a - --- | Gets the string and combines the needed parsers -stringParser :: TextRenderInfo -> FontIndex -> Maybe [Action] - -> Parser [[(Widget, TextRenderInfo, FontIndex, Maybe [Action])]] -stringParser c f a = manyTill (allParsers c f a) eof - --- | Parses a maximal string without markup. -textParser :: TextRenderInfo -> FontIndex -> Maybe [Action] - -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -textParser c f a = do s <- many1 $ - noneOf "<" <|> - try (notFollowedBy' (char '<') - (try (string "fc=") <|> - try (string "box") <|> - try (string "fn=") <|> - try (string "action=") <|> - try (string "/action>") <|> - try (string "icon=") <|> - try (string "raw=") <|> - try (string "/fn>") <|> - try (string "/box>") <|> - string "/fc>")) - return [(Text s, c, f, a)] - --- | 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 :: TextRenderInfo - -> FontIndex - -> Maybe [Action] - -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -rawParser c f a = do - string "<raw=" - lenstr <- many1 digit - char ':' - case reads lenstr of - [(len,[])] -> do - guard ((len :: Integer) <= fromIntegral (maxBound :: Int)) - s <- count (fromIntegral len) anyChar - string "/>" - return [(Text s, c, f, a)] - _ -> mzero - --- | 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 - notFollowedBy $ try (e >> return '*') - return x - -iconParser :: TextRenderInfo -> FontIndex -> Maybe [Action] - -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -iconParser c f a = do - string "<icon=" - i <- manyTill (noneOf ">") (try (string "/>")) - return [(Icon i, c, f, a)] - -actionParser :: TextRenderInfo -> FontIndex -> Maybe [Action] - -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -actionParser c f act = do - string "<action=" - command <- choice [between (char '`') (char '`') (many1 (noneOf "`")), - many1 (noneOf ">")] - buttons <- (char '>' >> return "1") <|> (space >> spaces >> - between (string "button=") (string ">") (many1 (oneOf "12345"))) - let a = Spawn (toButtons buttons) command - a' = case act of - Nothing -> Just [a] - Just act' -> Just $ a : act' - s <- manyTill (allParsers c f a') (try $ string "</action>") - return (concat s) - -toButtons :: String -> [Button] -toButtons = map (\x -> read [x]) - --- | Parsers a string wrapped in a color specification. -colorParser :: TextRenderInfo -> FontIndex -> Maybe [Action] - -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -colorParser (TextRenderInfo _ _ _ bs) f a = do - c <- between (string "<fc=") (string ">") colors - let colorParts = break (==':') c - let (ot,ob) = case break (==',') (Prelude.drop 1 $ snd colorParts) of - (top,',':btm) -> (top, btm) - (top, _) -> (top, top) - s <- manyTill - (allParsers (TextRenderInfo (fst colorParts) (fromMaybe (-1) $ readMaybe ot) (fromMaybe (-1) $ readMaybe ob) bs) f a) - (try $ string "</fc>") - return (concat s) - --- | Parses a string wrapped in a box specification. -boxParser :: TextRenderInfo -> FontIndex -> Maybe [Action] - -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -boxParser (TextRenderInfo cs ot ob bs) f a = do - c <- between (string "<box") (string ">") (option "" (many1 (alphaNum <|> char '=' <|> char ' ' <|> char '#' <|> char ','))) - let b = Box BBFull (BoxOffset C 0) 1 cs (BoxMargins 0 0 0 0) - let g = boxReader b (words c) - s <- manyTill - (allParsers (TextRenderInfo cs ot ob (g : bs)) f a) - (try $ string "</box>") - return (concat s) - -boxReader :: Box -> [String] -> Box -boxReader b [] = b -boxReader b (x:xs) = do - let (param,val) = case break (=='=') x of - (p,'=':v) -> (p, v) - (p, _) -> (p, "") - boxReader (boxParamReader b param val) xs - -boxParamReader :: Box -> String -> String -> Box -boxParamReader b _ "" = b -boxParamReader (Box bb off lw fc mgs) "type" val = - Box (fromMaybe bb $ readMaybe ("BB" ++ val)) off lw fc mgs -boxParamReader (Box bb (BoxOffset alg off) lw fc mgs) "offset" (a:o) = - Box bb (BoxOffset (fromMaybe alg $ readMaybe [a]) (fromMaybe off $ readMaybe o)) lw fc mgs -boxParamReader (Box bb off lw fc mgs) "width" val = - Box bb off (fromMaybe lw $ readMaybe val) fc mgs -boxParamReader (Box bb off lw _ mgs) "color" val = - Box bb off lw val mgs -boxParamReader (Box bb off lw fc mgs@(BoxMargins mt mr mb ml)) ('m':pos) val = do - let mgs' = case pos of - "t" -> BoxMargins (fromMaybe mt $ readMaybe val) mr mb ml - "r" -> BoxMargins mt (fromMaybe mr $ readMaybe val) mb ml - "b" -> BoxMargins mt mr (fromMaybe mb $ readMaybe val) ml - "l" -> BoxMargins mt mr mb (fromMaybe ml $ readMaybe val) - _ -> mgs - Box bb off lw fc mgs' -boxParamReader b _ _ = b - --- | Parsers a string wrapped in a font specification. -fontParser :: TextRenderInfo -> Maybe [Action] - -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] -fontParser c a = do - f <- between (string "<fn=") (string ">") colors - s <- manyTill (allParsers c (fromMaybe 0 $ readMaybe f) a) (try $ string "</fn>") - return (concat s) - --- | Parses a color specification (hex or named) -colors :: Parser String -colors = many1 (alphaNum <|> char ',' <|> char ':' <|> char '#') diff -pruN 0.36-2/src/Xmobar/X11/Text.hs 0.46-1/src/Xmobar/X11/Text.hs --- 0.36-2/src/Xmobar/X11/Text.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Text.hs 2001-09-09 01:46:40.000000000 +0000 @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar.X11.Text --- Copyright : (C) 2011, 2012, 2013, 2014, 2015, 2017, 2018 Jose Antonio Ortega Ruiz +-- Copyright : (C) 2011-2015, 2017, 2018, 2022 Jose Antonio Ortega Ruiz -- (C) 2007 Andrea Rossato -- License : BSD3 -- @@ -14,116 +14,44 @@ ----------------------------------------------------------------------------- module Xmobar.X11.Text - ( XFont(..) + ( XFont , initFont - , initCoreFont - , initUtf8Font , textExtents , textWidth ) where -import Control.Exception (SomeException, handle) -import Data.List -import Foreign -import Graphics.X11.Xlib hiding (textExtents, textWidth) -import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth) -import Graphics.X11.Xlib.Extras -import System.Mem.Weak ( addFinalizer ) - -#if defined XFT -import Xmobar.X11.MinXft -import Graphics.X11.Xrender -#else -import System.IO(hPutStrLn, stderr) -#endif - -data XFont = Core FontStruct - | Utf8 FontSet -#ifdef XFT - | Xft [AXftFont] -#endif - --- | When initFont gets a font name that starts with 'xft:' it switchs --- to the Xft backend Example: 'xft:Sans-10' -initFont :: Display -> String -> IO XFont -initFont d s = - let xftPrefix = "xft:" in - if xftPrefix `isPrefixOf` s then -#ifdef XFT - fmap Xft $ initXftFont d s -#else - do - hPutStrLn stderr $ "Warning: Xmobar must be built with " - ++ "the with_xft flag to support font '" ++ s - ++ ".' Falling back on default." - initFont d miscFixedFont -#endif - else - fmap Utf8 $ initUtf8Font d s +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. -initCoreFont :: Display -> String -> IO FontStruct -initCoreFont d s = do - f <- handle fallBack getIt - addFinalizer f (freeFont d f) - return f - where getIt = loadQueryFont d s - fallBack :: SomeException -> IO FontStruct - fallBack = const $ loadQueryFont d miscFixedFont - --- | Given a fontname returns the font structure. If the font name is --- not valid the default font will be loaded and returned. -initUtf8Font :: Display -> String -> IO FontSet +initUtf8Font :: X.Display -> String -> IO Xx.FontSet initUtf8Font d s = do - (_,_,f) <- handle fallBack getIt - addFinalizer f (freeFontSet d f) + (_,_,f) <- E.handle fallBack getIt + W.addFinalizer f (Xx.freeFontSet d f) return f - where getIt = createFontSet d s - fallBack :: SomeException -> IO ([String], String, FontSet) - fallBack = const $ createFontSet d miscFixedFont - -#ifdef XFT -initXftFont :: Display -> String -> IO [AXftFont] -initXftFont d s = do - let fontNames = wordsBy (== ',') (drop 4 s) - mapM openFont fontNames - where - openFont fontName = do - f <- openAXftFont d (defaultScreenOfDisplay d) fontName - addFinalizer f (closeAXftFont d f) - return f - wordsBy p str = case dropWhile p str of - "" -> [] - str' -> w : wordsBy p str'' - where - (w, str'') = break p str' -#endif - -textWidth :: Display -> XFont -> String -> IO Int -textWidth _ (Utf8 fs) s = return $ fromIntegral $ wcTextEscapement fs s -textWidth _ (Core fs) s = return $ fromIntegral $ Xlib.textWidth fs s -#ifdef XFT -textWidth dpy (Xft xftdraw) s = do - gi <- xftTxtExtents' dpy xftdraw s - return $ xglyphinfo_xOff gi -#endif - -textExtents :: XFont -> String -> IO (Int32,Int32) -textExtents (Core fs) s = do - let (_,a,d,_) = Xlib.textExtents fs s - return (a,d) -textExtents (Utf8 fs) s = do - let (_,rl) = wcTextExtents fs s - ascent = fromIntegral $ - (rect_y rl) - descent = fromIntegral $ rect_height rl + fromIntegral (rect_y rl) - return (ascent, descent) -#ifdef XFT -textExtents (Xft xftfonts) _ = do - ascent <- fromIntegral `fmap` xft_ascent' xftfonts - descent <- fromIntegral `fmap` xft_descent' xftfonts + 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) -#endif diff -pruN 0.36-2/src/Xmobar/X11/Types.hs 0.46-1/src/Xmobar/X11/Types.hs --- 0.36-2/src/Xmobar/X11/Types.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Types.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Types --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2022 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -15,27 +15,27 @@ ------------------------------------------------------------------------------ -module Xmobar.X11.Types (X, XConf (..)) where +module Xmobar.X11.Types where -import Graphics.X11.Xlib -import Control.Monad.Reader -import Data.Map +import qualified Graphics.X11.Xlib as X11 import qualified Data.List.NonEmpty as NE -import Xmobar.X11.Bitmap -import Xmobar.X11.Text +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 :: Display - , rect :: Rectangle - , window :: Window - , fontListS :: NE.NonEmpty XFont - , verticalOffsets :: [Int] - , iconS :: Map FilePath Bitmap + XConf { display :: X11.Display + , rect :: X11.Rectangle + , window :: X11.Window + , fontList :: NE.NonEmpty XFont + , iconCache :: BitmapCache , config :: Config } diff -pruN 0.36-2/src/Xmobar/X11/Window.hs 0.46-1/src/Xmobar/X11/Window.hs --- 0.36-2/src/Xmobar/X11/Window.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/Window.hs 2001-09-09 01:46:40.000000000 +0000 @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Window --- Copyright : (c) 2011-18, 20 Jose A. Ortega Ruiz +-- Copyright : (c) 2011-18, 2020-22 Jose A. Ortega Ruiz -- : (c) 2012 Jochen Keil -- License : BSD-style (see LICENSE) -- @@ -15,159 +15,177 @@ module Xmobar.X11.Window where -import Prelude -import Control.Monad (when, unless) -import Graphics.X11.Xlib hiding (textExtents) -import Graphics.X11.Xlib.Extras -import Graphics.X11.Xinerama -import Foreign.C.Types (CLong) - -import Data.Function (on) -import Data.List (maximumBy) -import Data.Maybe (fromMaybe) -import System.Posix.Process (getProcessID) +import qualified Control.Monad as CM -import Xmobar.Config.Types -import Xmobar.X11.Text +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 :: Display -> Screen -> Window -> Rectangle -> Bool -> IO Window -newWindow dpy scr rw (Rectangle x y w h) o = do - let visual = defaultVisualOfScreen scr - attrmask = if o then cWOverrideRedirect else 0 - allocaSetWindowAttributes $ +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 - set_override_redirect attributes o - createWindow dpy rw x y w h 0 (defaultDepthOfScreen scr) - inputOutput visual attrmask attributes + 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 :: Display -> XFont -> Config -> IO (Rectangle,Window) +createWin :: X.Display -> Txt.XFont -> T.Config -> IO (X.Rectangle, X.Window) createWin d fs c = do - let dflt = defaultScreen d - srs <- getScreenInfo d - rootw <- rootWindow d dflt - (as,ds) <- textExtents fs "0" + 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 (position c) srs (fromIntegral ht) - win <- newWindow d (defaultScreenOfDisplay d) rootw r (overrideRedirect c) + 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 - when (lowerOnStart c) $ lowerWindow d win - unless (hideOnStart c) $ showWindow r c d win + 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 :: Display -> Window -> XFont -> Config -> IO Rectangle +repositionWin :: X.Display -> X.Window -> Txt.XFont -> T.Config -> IO X.Rectangle repositionWin d win fs c = do - srs <- getScreenInfo d - (as,ds) <- textExtents fs "0" + srs <- Xi.getScreenInfo d + (as,ds) <- Txt.textExtents fs "0" let ht = as + ds + 4 - r = setPosition c (position c) srs (fromIntegral ht) - moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r) + 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 :: Config -> XPosition -> [Rectangle] -> Dimension -> Rectangle +setPosition :: + T.Config -> T.XPosition -> [X.Rectangle] -> X.Dimension -> X.Rectangle setPosition c p rs ht = case p' of - Top -> Rectangle rx ry rw h - TopP l r -> Rectangle (rx + fi l) ry (rw - fi l - fi r) h - TopW a i -> Rectangle (ax a i) ry (nw i) h - TopSize a i ch -> Rectangle (ax a i) ry (nw i) (mh ch) - Bottom -> Rectangle rx ny rw h - BottomW a i -> Rectangle (ax a i) ny (nw i) h - BottomP l r -> Rectangle (rx + fi l) ny (rw - fi l - fi r) h - BottomSize a i ch -> Rectangle (ax a i) (ny' ch) (nw i) (mh ch) - Static cx cy cw ch -> Rectangle (fi cx) (fi cy) (fi cw) (fi ch) - OnScreen _ p'' -> setPosition c p'' [scr] ht + 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@(Rectangle rx ry rw rh), p') = - case p of OnScreen i x -> (fromMaybe (picker rs) $ safeIndex i rs, x) + (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 L = const rx - ax R = right - ax C = center + 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 pickBroadest c - then maximumBy (compare `on` rect_width) + picker = if T.pickBroadest c + then DL.maximumBy (compare `DF.on` X.rect_width) else head -setProperties :: Config -> Display -> Window -> IO () +setProperties :: T.Config -> X.Display -> X.Window -> IO () setProperties c d w = do - let mkatom n = internAtom d n False + let mkatom n = X.internAtom d n False card <- mkatom "CARDINAL" atom <- mkatom "ATOM" - setTextProperty d w (wmClass c) wM_CLASS - setTextProperty d w (wmName c) wM_NAME + 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" - changeProperty32 d w wtype atom propModeReplace [fi dock] + Xx.changeProperty32 d w wtype atom Xx.propModeReplace [fi dock] - when (allDesktops c) $ do + CM.when (T.allDesktops c) $ do desktop <- mkatom "_NET_WM_DESKTOP" - changeProperty32 d w desktop card propModeReplace [0xffffffff] + Xx.changeProperty32 d w desktop card Xx.propModeReplace [0xffffffff] pid <- mkatom "_NET_WM_PID" - getProcessID >>= changeProperty32 d w pid card propModeReplace . return . fi + PP.getProcessID >>= + Xx.changeProperty32 d w pid card Xx.propModeReplace . return . fi -setStruts' :: Display -> Window -> [Foreign.C.Types.CLong] -> IO () +setStruts' :: X.Display -> X.Window -> [C.CLong] -> IO () setStruts' d w svs = do - let mkatom n = internAtom d n False + let mkatom n = X.internAtom d n False card <- mkatom "CARDINAL" pstrut <- mkatom "_NET_WM_STRUT_PARTIAL" strut <- mkatom "_NET_WM_STRUT" - changeProperty32 d w pstrut card propModeReplace svs - changeProperty32 d w strut card propModeReplace (take 4 svs) + Xx.changeProperty32 d w pstrut card Xx.propModeReplace svs + Xx.changeProperty32 d w strut card Xx.propModeReplace (take 4 svs) -setStruts :: Rectangle -> Config -> Display -> Window -> [Rectangle] -> IO () +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 (position c) (getRootWindowHeight rs) + let svs = map fi $ getStrutValues r (T.position c) (getRootWindowHeight rs) setStruts' d w svs -getRootWindowHeight :: [Rectangle] -> Int +getRootWindowHeight :: [X.Rectangle] -> Int getRootWindowHeight srs = maximum (map getMaxScreenYCoord srs) where - getMaxScreenYCoord sr = fi (rect_y sr) + fi (rect_height sr) + getMaxScreenYCoord sr = fi (X.rect_y sr) + fi (X.rect_height sr) -getStrutValues :: Rectangle -> XPosition -> Int -> [Int] -getStrutValues r@(Rectangle x y w h) p rwh = +getStrutValues :: X.Rectangle -> T.XPosition -> Int -> [Int] +getStrutValues r@(X.Rectangle x y w h) p rwh = case p of - OnScreen _ p' -> getStrutValues r p' rwh - Top -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] - TopP _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] - TopW _ _ -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] - TopSize {} -> [0, 0, st, 0, 0, 0, 0, 0, nx, nw, 0, 0] - Bottom -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] - BottomP _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] - BottomW _ _ -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] - BottomSize {} -> [0, 0, 0, sb, 0, 0, 0, 0, 0, 0, nx, nw] - Static {} -> getStaticStrutValues p rwh + 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 :: XPosition -> Int -> [Int] -getStaticStrutValues (Static cx cy cw ch) rwh +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] @@ -175,54 +193,20 @@ getStaticStrutValues (Static cx cy cw ch where st = cy + ch sb = rwh - cy xs = cx -- a simple calculation for horizontal (x) placement - xe = xs + cw + xe = xs + cw - 1 getStaticStrutValues _ _ = [0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0] -drawBorder :: Border -> Int -> Display -> Drawable -> GC -> Pixel - -> Dimension -> Dimension -> IO () -drawBorder b lw d p gc c wi ht = case b of - NoBorder -> return () - TopB -> drawBorder (TopBM 0) lw d p gc c wi ht - BottomB -> drawBorder (BottomBM 0) lw d p gc c wi ht - FullB -> drawBorder (FullBM 0) lw d p gc c wi ht - TopBM m -> sf >> sla >> - drawLine d p gc 0 (fi m + boff) (fi wi) (fi m + boff) - BottomBM m -> let rw = fi ht - fi m + boff in - sf >> sla >> drawLine d p gc 0 rw (fi wi) rw - FullBM m -> let mp = fi m - pad = 2 * fi mp + fi lw - in sf >> sla >> - drawRectangle d p gc mp mp (wi - pad) (ht - pad) - where sf = setForeground d gc c - sla = setLineAttributes d gc (fi lw) lineSolid capNotLast joinMiter - boff = borderOffset b lw --- boff' = calcBorderOffset lw :: Int - -hideWindow :: Display -> Window -> IO () +hideWindow :: X.Display -> X.Window -> IO () hideWindow d w = do setStruts' d w (replicate 12 0) - unmapWindow d w >> sync d False + Xx.unmapWindow d w >> X.sync d False -showWindow :: Rectangle -> Config -> Display -> Window -> IO () +showWindow :: X.Rectangle -> T.Config -> X.Display -> X.Window -> IO () showWindow r c d w = do - mapWindow d w - getScreenInfo d >>= setStruts r c d w - sync d False - -isMapped :: Display -> Window -> IO Bool -isMapped d w = ism <$> getWindowAttributes d w - where ism WindowAttributes { wa_map_state = wms } = wms /= waIsUnmapped - -borderOffset :: (Integral a) => Border -> Int -> a -borderOffset b lw = - case b of - BottomB -> negate boffs - BottomBM _ -> negate boffs - TopB -> boffs - TopBM _ -> boffs - _ -> 0 - where boffs = calcBorderOffset lw - -calcBorderOffset :: (Integral a) => Int -> a -calcBorderOffset = ceiling . (/2) . toDouble - where toDouble = fi :: (Integral a) => a -> Double + 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 diff -pruN 0.36-2/src/Xmobar/X11/XRender.hsc 0.46-1/src/Xmobar/X11/XRender.hsc --- 0.36-2/src/Xmobar/X11/XRender.hsc 1970-01-01 00:00:00.000000000 +0000 +++ 0.46-1/src/Xmobar/X11/XRender.hsc 2001-09-09 01:46:40.000000000 +0000 @@ -0,0 +1,138 @@ +------------------------------------------------------------------------------ +-- | +-- 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 diff -pruN 0.36-2/src/Xmobar.hs 0.46-1/src/Xmobar.hs --- 0.36-2/src/Xmobar.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/src/Xmobar.hs 2001-09-09 01:46:40.000000000 +0000 @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar --- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017, 2018, 2019 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017, 2018, 2019, 2022 Jose Antonio Ortega Ruiz -- (c) 2007 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -23,6 +23,7 @@ module Xmobar (xmobar , Runnable (..) , Exec (..) , Command (..) + , SignalType (..) , module Xmobar.Config.Types , module Xmobar.Config.Parse , module Xmobar.Plugins.BufferedPipeReader @@ -33,12 +34,14 @@ module Xmobar (xmobar #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 @@ -48,9 +51,9 @@ module Xmobar (xmobar import Xmobar.Run.Runnable import Xmobar.Run.Exec -import Xmobar.Run.Command import Xmobar.Config.Types import Xmobar.Config.Parse +import Xmobar.Plugins.Command import Xmobar.Plugins.BufferedPipeReader import Xmobar.Plugins.CommandReader import Xmobar.Plugins.Date @@ -59,6 +62,7 @@ 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 @@ -70,6 +74,9 @@ 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) diff -pruN 0.36-2/stack.yaml 0.46-1/stack.yaml --- 0.36-2/stack.yaml 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/stack.yaml 1970-01-01 00:00:00.000000000 +0000 @@ -1,26 +0,0 @@ -# ghc 8.6.5 -resolver: lts-14.20 - -packages: - - . - -flags: - xmobar: - all_extensions: true - with_threaded: true - -extra-deps: - - netlink-1.1.1.0 - -nix: - packages: - - alsaLib - - pkgconfig - - wirelesstools - - xorg.libX11 - - xorg.libXext - - xorg.libXft - - xorg.libXpm - - xorg.libXrandr - - xorg.libXScrnSaver - - zlib diff -pruN 0.36-2/test/Xmobar/Plugins/Monitors/CommonSpec.hs 0.46-1/test/Xmobar/Plugins/Monitors/CommonSpec.hs --- 0.36-2/test/Xmobar/Plugins/Monitors/CommonSpec.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/test/Xmobar/Plugins/Monitors/CommonSpec.hs 2001-09-09 01:46:40.000000000 +0000 @@ -13,7 +13,7 @@ spec :: Spec spec = describe "Common.padString" $ do it "returns given string when called with default values" $ - do padString 0 0 "" False "" "test" `shouldBe` "test" + padString 0 0 "" False "" "test" `shouldBe` "test" it "truncates to max width" $ do let maxw = 3 @@ -27,3 +27,9 @@ spec = 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 diff -pruN 0.36-2/test/Xmobar/Plugins/Monitors/CpuSpec.hs 0.46-1/test/Xmobar/Plugins/Monitors/CpuSpec.hs --- 0.36-2/test/Xmobar/Plugins/Monitors/CpuSpec.hs 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/test/Xmobar/Plugins/Monitors/CpuSpec.hs 2001-09-09 01:46:40.000000000 +0000 @@ -23,7 +23,7 @@ spec = do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>% <bar>"] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs - cpuValue `shouldSatisfy` (\item -> "::" `isSuffixOf` item) + 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 diff -pruN 0.36-2/xmobar.cabal 0.46-1/xmobar.cabal --- 0.36-2/xmobar.cabal 2020-08-22 16:45:20.000000000 +0000 +++ 0.46-1/xmobar.cabal 2001-09-09 01:46:40.000000000 +0000 @@ -1,6 +1,6 @@ name: xmobar -version: 0.36 -homepage: http://xmobar.org +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. . @@ -12,27 +12,28 @@ license: BSD3 license-file: license author: Andrea Rossato and Jose A. Ortega Ruiz maintainer: Jose A. Ortega Ruiz <jao@gnu.org> -bug-reports: https://github.com/jaor/xmobar/issues +bug-reports: https://codeberg.org/xmobar/xmobar/issues cabal-version: >= 1.10 build-type: Simple -extra-source-files: readme.md, changelog.md, - examples/padding-icon.sh, - examples/xmobar.config, - examples/xmobar.hs, - examples/xmonadpropwrite.hs +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://github.com/jaor/xmobar.git + location: git://codeberg.org/xmobar/xmobar.git branch: master -flag with_xft - description: Use Xft to render text. UTF-8 support included. - default: False - -flag with_utf8 - description: With UTF-8 support. +flag with_xrender + description: Use XRender for alpha background pseudo-transparency. default: True flag with_inotify @@ -83,13 +84,17 @@ 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_weather - description: Enable weather plugin. - default: True +flag with_kraken + description: Enable Kraken plugin. + default: False library default-language: Haskell2010 @@ -98,65 +103,86 @@ library 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.Command, Xmobar.Run.Runnable - Xmobar.App.EventLoop, + 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.App.Timer, Xmobar.System.Utils, Xmobar.System.StatFS, Xmobar.System.Environment, Xmobar.System.Localize, Xmobar.System.Signal, Xmobar.System.Kbd, - Xmobar.X11.Actions, - Xmobar.X11.Events, - Xmobar.X11.Parsers, - Xmobar.X11.Types, - Xmobar.X11.Text, + 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.Window, 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.Common, + 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 @@ -166,24 +192,29 @@ library ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind build-depends: - base >= 4.11.0 && < 4.15, - containers, - regex-compat, - process, - old-locale, - bytestring >= 0.10.8.2, - directory, - unix, - time, - filepath, - transformers, - X11 >= 1.6.1, - mtl >= 2.1 && < 2.3, - parsec == 3.1.*, - parsec-numbers >= 0.1.0, - stm >= 2.3 && < 2.6, - extensible-exceptions == 0.1.*, - async + 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. @@ -195,20 +226,16 @@ library 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://github.com/jaor/xmobar/pull/36 + -- 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_xft) || flag(all_extensions) - build-depends: utf8-string >= 0.3 && < 1.1, X11-xft >= 0.2 && < 0.4 - other-modules: Xmobar.X11.MinXft - cpp-options: -DXFT - - if flag(with_utf8) || flag(all_extensions) - build-depends: utf8-string >= 0.3 && < 1.1 - cpp-options: -DUTF8 + 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 @@ -229,7 +256,7 @@ library cpp-options: -DUSE_NL80211 if flag(with_mpd) || flag(all_extensions) - build-depends: libmpd >= 0.9.0.10 + build-depends: libmpd >= 0.9.2.0 other-modules: Xmobar.Plugins.Monitors.MPD cpp-options: -DLIBMPD @@ -237,12 +264,12 @@ library 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 + 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.1 && < 0.3, timezone-series == 0.1.* + build-depends: timezone-olson >= 0.2 && < 0.3, timezone-series == 0.1.* other-modules: Xmobar.Plugins.DateZone cpp-options: -DDATEZONE @@ -271,23 +298,54 @@ library 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 - cpp-options: -DFREEBSD + 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: base, - containers, + build-depends: X11, async, - X11, + base, + containers, directory, filepath, - unix, parsec, + unix, xmobar ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind @@ -296,9 +354,6 @@ executable xmobar ghc-options: -with-rtsopts=-V0 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://github.com/jaor/xmobar/pull/36 ghc-options: -threaded cpp-options: -DTHREADED_RUNTIME @@ -307,25 +362,25 @@ test-suite XmobarTest type: exitcode-stdio-1.0 hs-source-dirs: src, test main-is: Spec.hs - build-depends: base, - containers, - regex-compat, - process, - old-locale, + build-depends: X11, + async, + base, bytestring, + containers, directory, - unix, - time, filepath, - transformers, - X11, + hspec == 2.*, mtl, + old-locale, parsec, parsec-numbers, + process, + regex-compat, stm, - async, temporary, - hspec == 2.*, + time, + transformers, + unix, xmobar other-modules: Xmobar.Plugins.Monitors.CommonSpec @@ -335,9 +390,11 @@ test-suite XmobarTest 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.App.Timer + Xmobar.Run.Timer Xmobar.System.Signal if flag(with_alsa) || flag(all_extensions) @@ -347,15 +404,20 @@ test-suite XmobarTest other-modules: Xmobar.Plugins.Monitors.Volume Xmobar.Plugins.Monitors.Alsa Xmobar.Plugins.Monitors.AlsaSpec - Xmobar.Plugins.Monitors.CpuSpec 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: -O2 - build-depends: base, gauge, xmobar, mtl + 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