diff -Nru xmobar-0.33/bench/main.hs xmobar-0.36/bench/main.hs --- xmobar-0.33/bench/main.hs 1970-01-01 01:00:00.000000000 +0100 +++ xmobar-0.36/bench/main.hs 2020-08-22 18:45:20.000000000 +0200 @@ -0,0 +1,32 @@ +{-#LANGUAGE RecordWildCards#-} + +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 + +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 + +normalCpuBench :: CpuArguments -> [Benchmark] +normalCpuBench args = [bench "CPU normal args" (cpuBenchmark args)] diff -Nru xmobar-0.33/changelog.md xmobar-0.36/changelog.md --- xmobar-0.33/changelog.md 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/changelog.md 2020-08-22 18:45:20.000000000 +0200 @@ -1,3 +1,46 @@ +## Version 0.36 (August, 2020) + +_New features_ + + - Monitor progress bars: a value of 0 for `-W` denotes an index in + the `-f` string, similar to icon patterns but using characters. + - New tag `` to add borders around text (Unoqwy). + - `fc` color background now accepts an offset (Unoqwy). + +_Bug fixes_ + + - Documentation fixes (Tomáš Janoušek) + - Don't get confused by empty configuration dirs (fixes #412) + - Xft rendering: Avoid encoding to UTF8 on all scenarios. This + causes issue to StdinReader monitor when the handle wasn't binary. + +## Version 0.35.1 (June, 2020) + +- Dropped support for GHC < 8.4 (see issue #461) + +## Version 0.35 (June, 2020) + +_New features_ + + - `MultiCoreTemp` now works with Ryzen processors. New option + `--hwmonitor-path` for better performance. + - CPU Monitor optimizations. + - Version bumps for some dependencies, including timezone-olson. + +## Version 0.34 (June, 2020) + +_New features_ + + - New plugin `HandleReader` for reading data from a Haskell `Handle`. This is + useful if you are running xmobar from within a Haskell program. + - Build with ghc 8.10 allowed. + - Optimize date plugin by avoiding calling getTimeZone for each of + the time the date has to be updated. Instead, it's computed once + at the start and re-used for each invocation. + - Optimize Weather and UVMeter plugin by using global Manager + instead of creating for each http request when useManager is + explicitly configured as False. + ## Version 0.33 (February, 2020) _New features_ diff -Nru xmobar-0.33/debian/changelog xmobar-0.36/debian/changelog --- xmobar-0.33/debian/changelog 2020-10-12 05:38:08.000000000 +0200 +++ xmobar-0.36/debian/changelog 2020-11-10 17:54:51.000000000 +0100 @@ -1,4 +1,30 @@ -xmobar (0.33-1ubuntu1) groovy; urgency=medium +xmobar (0.36-2ubuntu1) UNRELEASED; urgency=medium + + * Merge newer version from Debian (LP: #1902343) + * Remaining changes: + d/tests/xmobar: wait a little longer for X server to be ready. + + -- Hans Joachim Desserud Tue, 10 Nov 2020 17:54:51 +0100 + +xmobar (0.36-2) unstable; urgency=medium + + * Move maintenance under DHG + + Move myself to Uploaders + + Point Vcs-* to the DHG_packages repository + * Enable ALSA support; thanks to William Wilhelm + + B-D on libghc-alsa-core-dev and libghc-alsa-mixer-dev + + -- Apollon Oikonomopoulos Thu, 29 Oct 2020 11:20:33 +0200 + +xmobar (0.36-1) unstable; urgency=medium + + * New upstream version 0.36 + * d/copyright: bump years + * d/rules: replace with_conduit w/ with_weather + + -- Apollon Oikonomopoulos Wed, 28 Oct 2020 13:41:25 +0200 + + xmobar (0.33-1ubuntu1) groovy; urgency=medium * d/tests/xmobar: wait a little longer for X server to be ready. diff -Nru xmobar-0.33/debian/control xmobar-0.36/debian/control --- xmobar-0.33/debian/control 2020-08-27 02:15:49.000000000 +0200 +++ xmobar-0.36/debian/control 2020-11-10 17:54:51.000000000 +0100 @@ -2,11 +2,14 @@ Section: x11 Priority: optional Maintainer: Ubuntu Developers -XSBC-Original-Maintainer: Apollon Oikonomopoulos -Uploaders: Aggelos Avgerinos , +XSBC-Original-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], @@ -22,8 +25,8 @@ libghc-x11-xft-dev (>= 0.2), libiw-dev [linux-any], libxpm-dev, -Vcs-Browser: https://salsa.debian.org/debian/xmobar -Vcs-Git: https://salsa.debian.org/debian/xmobar.git +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/ Package: xmobar diff -Nru xmobar-0.33/debian/copyright xmobar-0.36/debian/copyright --- xmobar-0.33/debian/copyright 2019-01-14 21:02:30.000000000 +0100 +++ xmobar-0.36/debian/copyright 2020-10-29 10:07:53.000000000 +0100 @@ -5,11 +5,11 @@ Files: * Copyright: Copyright 2007-2010 Andrea Rossato - Copyright 2010-2018 Jose Antonio Ortega Ruiz + Copyright 2010-2020 Jose Antonio Ortega Ruiz License: BSD-3-Clause Files: debian/* -Copyright: Copyright 2008-2019 Apollon Oikonomopoulos +Copyright: Copyright 2008-2020 Apollon Oikonomopoulos Copyright 2018 Aggelos Avgerinos License: BSD-3-Clause diff -Nru xmobar-0.33/debian/rules xmobar-0.36/debian/rules --- xmobar-0.33/debian/rules 2019-01-15 00:39:34.000000000 +0100 +++ xmobar-0.36/debian/rules 2020-10-29 10:18:21.000000000 +0100 @@ -15,7 +15,7 @@ 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_conduit" + CONFIGURE_OPTS += --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" endif diff -Nru xmobar-0.33/.github/workflows/haskell.yml xmobar-0.36/.github/workflows/haskell.yml --- xmobar-0.33/.github/workflows/haskell.yml 1970-01-01 01:00:00.000000000 +0100 +++ xmobar-0.36/.github/workflows/haskell.yml 2020-08-22 18:45:20.000000000 +0200 @@ -0,0 +1,57 @@ +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 -Nru xmobar-0.33/license xmobar-0.36/license --- xmobar-0.33/license 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/license 2020-08-22 18:45:20.000000000 +0200 @@ -1,4 +1,5 @@ -Copyright (c) Andrea Rossato +Copyright (c) 2007-2010 Andrea Rossato +Copyright (c) 2010-2020 Jose A Ortega Ruiz All rights reserved. diff -Nru xmobar-0.33/readme.md xmobar-0.36/readme.md --- xmobar-0.33/readme.md 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/readme.md 2020-08-22 18:45:20.000000000 +0200 @@ -1,5 +1,90 @@ [![Hackage](https://img.shields.io/hackage/v/xmobar.svg)](http://hackage.haskell.org/package/xmobar) -[![Build Status](https://travis-ci.org/jaor/xmobar.svg?branch=master)](https://travis-ci.org/jaor/xmobar) + + +**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) + + # About @@ -23,7 +108,7 @@ [xmonad]: http://xmonad.org [Ion3]: http://tuomov.iki.fi/software/ -# Bug Reports +# Bug reports To submit bug reports you can use the [bug tracker over at Github](https://github.com/jaor/xmobar/issues). @@ -182,7 +267,34 @@ may contain markups to change the characters' color. - `string` will print `string` with `#FF0000` color - (red). + (red). `string` will print `string` in red with + a black background (`#000000`). Background absolute offsets can be specified + for XFT fonts. `string` will have a background + matching the bar's height. + +- `string` 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: + + string + + and if you wanted an underline and an overline with a margin of 2 + pixels either side: + + string - `string` will print `string` with the first font from `additionalFonts`. The index `0` corresponds to the standard font. @@ -393,106 +505,6 @@ Mail bug reports and suggestions to -## 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 - ## The Output Template @@ -558,7 +570,7 @@ Other commands can be created as plugins with the Plugin infrastructure. See below. -## System Monitor Plugins +# 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 @@ -569,7 +581,7 @@ monitor in turn, but before we provide a list of the configuration options (or *monitor arguments*) they all share. -### Icon patterns +## 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 @@ -587,7 +599,7 @@ Will display `bright_0.xpm` to `bright_8.xpm` depending on current brightness value. -### Default Monitor Arguments +## Default Monitor Arguments Monitors accept a common set of arguments, described in the first subsection below. In addition, some monitors accept additional options @@ -706,6 +718,10 @@ - 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` @@ -723,7 +739,7 @@ Glasgow Airport: 16.0C -### `Uptime Args RefreshRate` +## `Uptime Args RefreshRate` - Aliases to `uptime` - Args: default monitor arguments. The low and high @@ -734,7 +750,7 @@ to add units to the display of those numeric fields. - Default template: `Up: d h m` -### `Weather StationID Args RefreshRate` +## `Weather StationID Args RefreshRate` - Aliases to the Station ID: so `Weather "LIPB" []` can be used in template as `%LIPB%` @@ -757,7 +773,7 @@ - Default template: `: C, rh % ()` - Retrieves weather information from http://tgftp.nws.noaa.gov. -### `WeatherX StationID SkyConditions Args RefreshRate` +## `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 @@ -790,7 +806,7 @@ As mentioned, the replacement string can also be an icon specification, such as `("clear", "")`. -### `Network Interface Args RefreshRate` +## `Network Interface Args RefreshRate` - Aliases to the interface name: so `Network "eth0" []` can be used as `%eth0%` @@ -798,14 +814,17 @@ - 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`. 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.). + `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: `: KB|KB` -### `DynNetwork Args RefreshRate` +## `DynNetwork Args RefreshRate` - Active interface is detected automatically - Aliases to "dynnetwork" @@ -822,7 +841,7 @@ - Default template: `: KB|KB` - Example of usage of `--devices` option: `["--", "--devices", "wlp2s0,enp0s20f41"]` -### `Wireless Interface Args RefreshRate` +## `Wireless Interface Args RefreshRate` - If set to "", first suitable wireless interface is used. - Aliases to the interface name with the suffix "wi": thus, `Wireless @@ -840,7 +859,7 @@ - To activate this plugin you must pass `--flags="with_nl80211"` or `--flags="with_iwlib"` during compilation -### `Memory Args RefreshRate` +## `Memory Args RefreshRate` - Aliases to `memory` - Args: default monitor arguments, plus: @@ -855,7 +874,7 @@ `availableratio`, `availablebar`, `availablevbar`, `availableipat` - Default template: `Mem: % (M)` -### `Swap Args RefreshRate` +## `Swap Args RefreshRate` - Aliases to `swap` - Args: default monitor arguments @@ -864,7 +883,7 @@ `total`, `used`, `free`, `usedratio` - Default template: `Swap: %` -### `Cpu Args RefreshRate` +## `Cpu Args RefreshRate` - Aliases to `cpu` - Args: default monitor arguments, plus: @@ -874,7 +893,7 @@ `total`, `bar`, `vbar`, `ipat`, `user`, `nice`, `system`, `idle`, `iowait` - Default template: `Cpu: %` -### `MultiCpu Args RefreshRate` +## `MultiCpu Args RefreshRate` - Aliases to `multicpu` - Args: default monitor arguments, plus: @@ -896,11 +915,11 @@ and display one entry for each. - Default template: `Cpu: %` -### `Battery Args RefreshRate` +## `Battery Args RefreshRate` - Same as `BatteryP ["BAT", "BAT0", "BAT1", "BAT2"] Args RefreshRate`. -### `BatteryP Dirs Args RefreshRate` +## `BatteryP Dirs Args RefreshRate` - Aliases to `battery` @@ -981,13 +1000,13 @@ - The "idle" AC state is selected whenever the AC power entering the battery is zero. -### `BatteryN Dirs Args RefreshRate Alias` +## `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` +## `TopProc Args RefreshRate` - Aliases to `top` - Args: default monitor arguments. The low and high @@ -1004,7 +1023,7 @@ maximum and/or minimum width, using the `-m`/`-M` arguments. `no` gives the total number of processes. -### `TopMem Args RefreshRate` +## `TopMem Args RefreshRate` - Aliases to `topmem` - Args: default monitor arguments. The low and high @@ -1017,7 +1036,7 @@ 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` +## `DiskU Disks Args RefreshRate` - Aliases to `disku` - Disks: list of pairs of the form (device or mount point, template), @@ -1036,7 +1055,7 @@ ["-L", "20", "-H", "50", "-m", "1", "-p", "3"] 20 -### `DiskIO Disks Args RefreshRate` +## `DiskIO Disks Args RefreshRate` - Aliases to `diskio` - Disks: list of pairs of the form (device or mount point, template), @@ -1059,7 +1078,7 @@ DiskIO [("/", " "), ("sdb1", "")] [] 10 -### `ThermalZone Number Args RefreshRate` +## `ThermalZone Number Args RefreshRate` - Aliases to "thermaln": so `ThermalZone 0 []` can be used in template as `%thermal0%` @@ -1076,7 +1095,7 @@ Run ThermalZone 0 ["-t",": C"] 30 -#### `Thermal Zone Args RefreshRate` +## `Thermal Zone Args RefreshRate` - **This plugin is deprecated. Use `ThermalZone` instead.** @@ -1093,7 +1112,7 @@ Run Thermal "THRM" ["-t","iwl4965-temp: C"] 50 -### `CpuFreq Args RefreshRate` +## `CpuFreq Args RefreshRate` - Aliases to `cpufreq` - Args: default monitor arguments @@ -1107,7 +1126,7 @@ Run CpuFreq ["-t", "Freq:|GHz", "-L", "0", "-H", "2", "-l", "lightblue", "-n","white", "-h", "red"] 50 -### `CoreTemp Args RefreshRate` +## `CoreTemp Args RefreshRate` - Aliases to `coretemp` - Args: default monitor arguments @@ -1122,7 +1141,7 @@ "-L", "40", "-H", "60", "-l", "lightblue", "-n", "gray90", "-h", "red"] 50 -### `MultiCoreTemp Args RefreshRate` +## `MultiCoreTemp Args RefreshRate` - Aliases to `multicoretemp` - Args: default monitor arguments, plus: @@ -1132,6 +1151,15 @@ 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`, @@ -1147,10 +1175,10 @@ Run MultiCoreTemp ["-t", "Temp: °C | %", "-L", "60", "-H", "80", - "-l", "green", "-n", "yellow", "-h", "red" + "-l", "green", "-n", "yellow", "-h", "red", "--", "--mintemp", "20", "--maxtemp", "100"] 50 -### `Volume Mixer Element Args RefreshRate` +## `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%`. @@ -1203,7 +1231,7 @@ system. In addition, to activate this plugin you must pass `--flags="with_alsa"` during compilation. -### `Alsa Mixer Element Args` +## `Alsa Mixer Element Args` Like [Volume](#volume-mixer-element-args-refreshrate), but with the following differences: @@ -1222,7 +1250,7 @@ - `stdbuf` (from coreutils) must be (and most probably already is) in your `PATH`. -### `MPD Args RefreshRate` +## `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). @@ -1250,7 +1278,7 @@ " (<album>) <track>/<plength> <statei> [<flags>]", "--", "-P", ">>", "-Z", "|", "-S", "><"] 10 -### `Mpris1 PlayerName Args RefreshRate` +## `Mpris1 PlayerName Args RefreshRate` - Aliases to `mpris1` - Requires [dbus] and [text] packages. @@ -1266,7 +1294,7 @@ Run Mpris1 "clementine" ["-t", "<artist> - [<tracknumber>] <title>"] 10 -### `Mpris2 PlayerName Args RefreshRate` +## `Mpris2 PlayerName Args RefreshRate` - Aliases to `mpris2` - Requires [dbus] and [text] packages. @@ -1283,7 +1311,7 @@ Run Mpris2 "spotify" ["-t", "<artist> - [<composer>] <title>"] 10 -### `Mail Args Alias` +## `Mail Args Alias` - Args: list of maildirs in form `[("name1","path1"),...]`. Paths may start with a '~' @@ -1297,7 +1325,7 @@ ("lists", "~/var/mail/lists")] "mail" -### `MailX Args Opts Alias` +## `MailX Args Opts Alias` - Args: list of maildirs in form `[("name1","path1","color1"),...]`. Paths may start with a '~' @@ -1321,7 +1349,7 @@ "mail" -### `MBox Mboxes Opts Alias` +## `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 @@ -1348,7 +1376,7 @@ Run MBox [("I ", "inbox", "red"), ("O ", "~/foo/mbox", "")] ["-d", "/var/mail/", "-p", " "] "mbox" -### `XPropertyLog PropName` +## `XPropertyLog PropName` - Aliases to `PropName` - Reads the X property named by `PropName` (a string) and displays its @@ -1358,7 +1386,7 @@ [examples/xmonadpropwrite.hs script]: https://github.com/jaor/xmobar/raw/master/examples/xmonadpropwrite.hs -### `UnsafeXPropertyLog PropName` +## `UnsafeXPropertyLog PropName` - Aliases to `PropName` - Same as `XPropertyLog`, but the input is not filtered to avoid @@ -1366,17 +1394,17 @@ the value of the read property is responsible of performing any needed cleanups. -### `NamedXPropertyLog PropName Alias` +## `NamedXPropertyLog PropName Alias` - Aliases to `Alias` - Same as `XPropertyLog`, but a custom alias can be specified. -### `NamedXPropertyLog PropName Alias` +## `UnsafeNamedXPropertyLog PropName Alias` - Aliases to `Alias` - Same as `UnsafeXPropertyLog`, but a custom alias can be specified. -### `Brightness Args RefreshRate` +## `Brightness Args RefreshRate` - Aliases to `bright` - Args: default monitor arguments, plus the following specif ones: @@ -1394,7 +1422,7 @@ Run Brightness ["-t", "<bar>"] 60 -### `Kbd Opts` +## `Kbd Opts` - Registers to XKB/X11-Events and output the currently active keyboard layout. Supports replacement of layout names. @@ -1406,7 +1434,7 @@ Run Kbd [("us(dvorak)", "DV"), ("us", "US")] -### `Locks` +## `Locks` - Displays the status of Caps Lock, Num Lock and Scroll Lock. - Aliases to `locks` @@ -1414,7 +1442,7 @@ Run Locks -### `CatInt n filename` +## `CatInt n filename` - Reads and displays an integer from the file whose path is `filename` (especially useful with files in `/sys`). @@ -1424,7 +1452,7 @@ Run CatInt 0 "/sys/devices/platform/thinkpad_hwmon/fan1_input" [] 50 -### `UVMeter` +## `UVMeter` - Aliases to "uv " + station id. For example: `%uv Brisbane%` or `%uv Alice Springs%` @@ -1443,7 +1471,7 @@ Run UVMeter "Brisbane" ["-H", "3", "-L", "3", "--low", "green", "--high", "red"] 900 -## Executing External Commands +# 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 @@ -1484,9 +1512,9 @@ will display "N/A" if for some reason the `date` invocation fails. -## Other Plugins +# Other Plugins -### `StdinReader` +## `StdinReader` - Aliases to StdinReader - Displays any text received by xmobar on its standard input. @@ -1494,27 +1522,26 @@ 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` +## `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 remove tags from dynamic text that you - pipe-thru to xmobar's standard input, e.g. window's title. There is no way - to escape the tags, i.e. you can't print a literal `<action>` tag as a text - on xmobar. + 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` +## `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` +## `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`). @@ -1527,17 +1554,17 @@ - Sample usage: `Run DateZone "%a %H:%M:%S" "de_DE.UTF-8" "Europe/Vienna" "viennaTime" 10` -### `CommandReader "/path/to/program" Alias` +## `CommandReader "/path/to/program" Alias` - Runs the given program, and displays its standard output. -### `PipeReader "default text:/path/to/pipe" Alias` +## `PipeReader "default text:/path/to/pipe" Alias` - Reads its displayed output from the given pipe. - Prefix an optional default text separated by a colon - Expands environment variables in the first argument of syntax '${VAR}' or '$VAR' -### `MarqueePipeReader "default text:/path/to/pipe" (length, rate, sep) Alias` +## `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 @@ -1547,7 +1574,7 @@ - Expands environment variables in the first argument -### `BufferedPipeReader Alias [(Timeout, Bool, "/path/to/pipe1"), ..]` +## `BufferedPipeReader Alias [(Timeout, Bool, "/path/to/pipe1"), ..]` - Display data from multiple pipes. - Timeout (in tenth of seconds) is the value after which the previous @@ -1579,7 +1606,7 @@ [examples/status.sh]: http://github.com/jaor/xmobar/raw/master/examples/status.sh -### `XMonadLog` +## `XMonadLog` - Aliases to XMonadLog - Displays information from xmonad's `_XMONAD_LOG`. You can set this @@ -1597,7 +1624,7 @@ [here]: http://xmonad.org/xmonad-docs/xmonad-contrib/XMonad-Hooks-DynamicLog.html -### `UnsafeXMonadLog` +## `UnsafeXMonadLog` - Aliases to UnsafeXMonadLog - Similar to StdinReader versus UnsafeStdinReader, this does not strip `<action @@ -1610,7 +1637,123 @@ logHook = dynamicLogString myPP >>= xmonadPropLog } -# Plugins +## `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 @@ -1697,14 +1840,14 @@ 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, 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. +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 @@ -1738,10 +1881,10 @@ # License -This software is released under a BSD-style license. See [LICENSE] for +This software is released under a BSD-style license. See [license] for more details. -Copyright © 2010-2019 Jose Antonio Ortega Ruiz +Copyright © 2010-2020 Jose Antonio Ortega Ruiz Copyright © 2007-2010 Andrea Rossato diff -Nru xmobar-0.33/src/Xmobar/App/Config.hs xmobar-0.36/src/Xmobar/App/Config.hs --- xmobar-0.33/src/Xmobar/App/Config.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/App/Config.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Config.Defaults --- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -17,11 +17,10 @@ module Xmobar.App.Config (defaultConfig, - xmobarConfigDir, xmobarDataDir, xmobarConfigFile) where -import Control.Monad (when) +import Control.Monad (when, filterM) import System.Environment import System.Directory @@ -66,29 +65,6 @@ , verbose = False } --- | Return the path to the xmobar configuration directory. This --- directory is where user configuration files are stored (e.g, the --- xmobar.hs file). You may also create a @lib@ subdirectory in the --- configuration directory and the default recompile command will add --- it to the GHC include path. --- --- Several directories are considered. In order of --- preference: --- --- 1. The directory specified in the @XMOBAR_CONFIG_DIR@ environment variable. --- 2. The @~\/.xmobar@ directory. --- 3. The @XDG_CONFIG_HOME/xmobar@ directory. --- --- The first directory that exists will be used. If none of the --- directories exist then (1) will be used if it is set, otherwise (2) --- will be used. -xmobarConfigDir :: IO String -xmobarConfigDir = - findFirstDirWithEnv False "XMOBAR_CONFIG_DIR" - [ getAppUserDataDirectory "xmobar" - , getXdgDirectory XdgConfig "xmobar" - ] - -- | Return the path to the xmobar data directory. This directory is -- used by Xmobar to store data files such as the run-time state file -- and the configuration binary generated by GHC. @@ -140,11 +116,21 @@ Nothing -> findFirstDirOf create paths Just envPath -> findFirstDirOf create (return envPath:paths) +xmobarInConfigDirs :: FilePath -> IO (Maybe FilePath) +xmobarInConfigDirs fn = do + env <- lookupEnv "XMOBAR_CONFIG_DIR" + xdg <- getXdgDirectory XdgConfig "xmobar" + app <- getAppUserDataDirectory "xmobar" + hom <- getHomeDirectory + let candidates = case env of + Nothing -> [app, xdg, hom] + Just p -> [p, app, xdg, hom] + fs <- filterM (\d -> fileExist (d </> fn)) candidates + return $ if null fs then Nothing else Just (head fs </> fn) + xmobarConfigFile :: IO (Maybe FilePath) xmobarConfigFile = - ffirst [ xdg "xmobar.hs", xdg "xmobarrc", home ".xmobarrc"] - where xdg p = fmap (</> p) xmobarConfigDir - home p = fmap (</> p) getHomeDirectory - ffirst [] = return Nothing - ffirst (f:fs) = - f >>= fileExist >>= \e -> if e then fmap Just f else ffirst fs + fmap ffirst $ mapM xmobarInConfigDirs ["xmobar.hs", ".xmobarrc", "xmobarrc"] + where ffirst [] = Nothing + ffirst (Nothing:fs) = ffirst fs + ffirst (p:_) = p diff -Nru xmobar-0.33/src/Xmobar/App/EventLoop.hs xmobar-0.36/src/Xmobar/App/EventLoop.hs --- xmobar-0.33/src/Xmobar/App/EventLoop.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/App/EventLoop.hs 2020-08-22 18:45:20.000000000 +0200 @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.EventLoop --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -31,7 +31,6 @@ import Graphics.X11.Xrandr import Control.Arrow ((&&&)) -import Control.Applicative ((<$>)) import Control.Monad.Reader import Control.Concurrent import Control.Concurrent.Async (Async, async) @@ -40,6 +39,7 @@ 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 @@ -52,6 +52,7 @@ 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') @@ -208,7 +209,7 @@ eventLoop tv xc as signal reposWindow rcfg = do - r' <- repositionWin d w (head fs) rcfg + r' <- repositionWin d w (NE.head fs) rcfg eventLoop tv (XConf d r' w fs vos is rcfg) as signal updateConfigPosition ocfg = @@ -249,20 +250,20 @@ where is = s ++ "Updating..." ++ ss updateString :: Config -> TVar [String] - -> IO [[(Widget, String, Int, Maybe [Action])]] + -> 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, String, Int, Maybe [Action])]] +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, String, Int, Maybe [Action])] -> IO [(Maybe [Action], Position, Position)] + 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 (fs!!i) s >>= \tw -> return (a, 0, fi tw) + 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) $ diff -Nru xmobar-0.33/src/Xmobar/App/Main.hs xmobar-0.36/src/Xmobar/App/Main.hs --- xmobar-0.33/src/Xmobar/App/Main.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/App/Main.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Main --- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -26,9 +26,9 @@ import Data.List (intercalate) import System.Posix.Process (executeFile) import System.Environment (getArgs) -import System.FilePath -import System.FilePath.Posix (takeBaseName, takeDirectory) +import System.FilePath ((</>), takeBaseName, takeDirectory, takeExtension) import Text.Parsec.Error (ParseError) +import Data.List.NonEmpty (NonEmpty(..)) import Graphics.X11.Xlib @@ -63,7 +63,7 @@ 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 + startLoop (XConf d r w (fs :| fl) (to:ts) ic conf) sig refLock vars configFromArgs :: Config -> IO Config configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst diff -Nru xmobar-0.33/src/Xmobar/App/Opts.hs xmobar-0.36/src/Xmobar/App/Opts.hs --- xmobar-0.33/src/Xmobar/App/Opts.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/App/Opts.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Opts --- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -104,9 +104,9 @@ info :: String info = "xmobar " ++ showVersion version - ++ "\n (C) 2007 - 2010 Andrea Rossato " - ++ "\n (C) 2010 - 2019 Jose A Ortega Ruiz\n " - ++ mail ++ "\n" ++ license + ++ "\n (C) 2010 - 2020 Jose A Ortega Ruiz" + ++ "\n (C) 2007 - 2010 Andrea Rossato\n " + ++ mail ++ "\n" ++ license ++ "\n" mail :: String mail = "<mail@jao.io>" diff -Nru xmobar-0.33/src/Xmobar/Plugins/BufferedPipeReader.hs xmobar-0.36/src/Xmobar/Plugins/BufferedPipeReader.hs --- xmobar-0.33/src/Xmobar/Plugins/BufferedPipeReader.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/BufferedPipeReader.hs 2020-08-22 18:45:20.000000000 +0200 @@ -23,7 +23,6 @@ import Xmobar.Run.Exec import Xmobar.System.Signal import Xmobar.System.Environment -import Xmobar.System.Utils(hGetLineSafe) data BufferedPipeReader = BufferedPipeReader String [(Int, Bool, String)] deriving (Read, Show) @@ -55,7 +54,7 @@ reader :: (Int, Bool, FilePath) -> TChan (Int, Bool, String) -> IO () reader p@(to, tg, fp) tc = do fp' <- expandEnv fp - openFile fp' ReadWriteMode >>= hGetLineSafe >>= \dt -> + openFile fp' ReadWriteMode >>= hGetLine >>= \dt -> atomically $ writeTChan tc (to, tg, dt) reader p tc diff -Nru xmobar-0.33/src/Xmobar/Plugins/CommandReader.hs xmobar-0.36/src/Xmobar/Plugins/CommandReader.hs --- xmobar-0.33/src/Xmobar/Plugins/CommandReader.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/CommandReader.hs 2020-08-22 18:45:20.000000000 +0200 @@ -17,7 +17,6 @@ import System.IO import Xmobar.Run.Exec -import Xmobar.System.Utils (hGetLineSafe) import System.Process(runInteractiveCommand, getProcessExitCode) data CommandReader = CommandReader String String @@ -31,7 +30,7 @@ hClose hstderr hSetBinaryMode hstdout False hSetBuffering hstdout LineBuffering - forever ph (hGetLineSafe hstdout >>= cb) + forever ph (hGetLine hstdout >>= cb) where forever ph a = do a ec <- getProcessExitCode ph diff -Nru xmobar-0.33/src/Xmobar/Plugins/Date.hs xmobar-0.36/src/Xmobar/Plugins/Date.hs --- xmobar-0.33/src/Xmobar/Plugins/Date.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Date.hs 2020-08-22 18:45:20.000000000 +0200 @@ -31,8 +31,16 @@ instance Exec Date where alias (Date _ a _) = a - run (Date f _ _) = date f 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 :: String -> IO String -date format = fmap (formatTime defaultTimeLocale format) getZonedTime +date :: TimeZone -> String -> IO String +date timezone format = do + time <- getCurrentTime + let zonedTime = utcToZonedTime timezone time + pure $ formatTime defaultTimeLocale format zonedTime diff -Nru xmobar-0.33/src/Xmobar/Plugins/HandleReader.hs xmobar-0.36/src/Xmobar/Plugins/HandleReader.hs --- xmobar-0.33/src/Xmobar/Plugins/HandleReader.hs 1970-01-01 01:00:00.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/HandleReader.hs 2020-08-22 18:45:20.000000000 +0200 @@ -0,0 +1,70 @@ +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.HandleReader +-- Copyright : (c) Pavan Rikhi +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Pavan Rikhi <pavan.rikhi@gmail.com> +-- Stability : unstable +-- Portability : portable +-- +-- A plugin for reading from 'Handle's +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.HandleReader + ( HandleReader(..) + ) +where + +import System.IO ( Handle + , hIsEOF + , hGetLine + ) + +import Xmobar.Run.Exec ( Exec(..) ) + + +-- | A HandleReader displays any text received from a Handle. +-- +-- This is only useful if you are running @xmobar@ from other Haskell code. +-- You can create a pair of @(read, write)@ 'Handle's using +-- 'System.Process.createPipe'. Pass the @read@ 'Handle' to HandleReader +-- and write your desired output to the @write@ 'Handle'. +-- +-- @ +-- (readHandle, writeHandle) <- 'System.Process.createPipe' +-- xmobarProcess <- 'System.Posix.Process.forkProcess' $ 'Xmobar.xmobar' myConfig +-- { commands = +-- 'Xmobar.Run' ('HandleReader' readHandle "handle") : 'Xmobar.commands' myConfig +-- } +-- 'System.IO.hPutStr' writeHandle "Hello World" +-- @ +data HandleReader + = HandleReader + Handle + -- ^ The Handle to read from. + String + -- ^ Alias for the HandleReader + deriving (Show) + +-- | WARNING: This Read instance will throw an exception if used! It is +-- only implemented because it is required to use HandleReader with +-- 'Xmobar.Run' in 'Xmobar.commands'. +instance Read HandleReader where + -- | Throws an 'error'! + readsPrec = error "HandleReader: Read instance is stub" + +-- | Asynchronously read from the 'Handle'. +instance Exec HandleReader where + -- | Read from the 'Handle' until it is closed. + start (HandleReader handle _) cb = + untilM (hIsEOF handle) $ hGetLine handle >>= cb + -- | Use the 2nd argument to HandleReader as its alias. + alias (HandleReader _ a) = a + +-- Loop the action until predicateM returns True. +untilM :: Monad m => m Bool -> m () -> m () +untilM predicateM action = do + predicate <- predicateM + if predicate then return () else action >> untilM predicateM action diff -Nru xmobar-0.33/src/Xmobar/Plugins/MarqueePipeReader.hs xmobar-0.36/src/Xmobar/Plugins/MarqueePipeReader.hs --- xmobar-0.33/src/Xmobar/Plugins/MarqueePipeReader.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/MarqueePipeReader.hs 2020-08-22 18:45:20.000000000 +0200 @@ -14,16 +14,14 @@ module Xmobar.Plugins.MarqueePipeReader(MarqueePipeReader(..)) where -import System.IO (openFile, IOMode(ReadWriteMode), Handle) +import System.IO (openFile, IOMode(ReadWriteMode), Handle, hGetLine) import Xmobar.System.Environment import Xmobar.Run.Exec(Exec(alias, start), tenthSeconds) -import Xmobar.System.Utils(hGetLineSafe) import System.Posix.Files (getFileStatus, isNamedPipe) import Control.Concurrent(forkIO, threadDelay) import Control.Concurrent.STM (TChan, atomically, writeTChan, tryReadTChan, newTChan) import Control.Exception import Control.Monad(forever, unless) -import Control.Applicative ((<$>)) type Length = Int -- length of the text to display type Rate = Int -- delay in tenth seconds @@ -39,7 +37,7 @@ unless (null def) (cb def) checkPipe pipe h <- openFile pipe ReadWriteMode - line <- hGetLineSafe h + line <- hGetLine h chan <- atomically newTChan forkIO $ writer (toInfTxt line sep) sep len rate chan cb forever $ pipeToChan h chan @@ -50,7 +48,7 @@ pipeToChan :: Handle -> TChan String -> IO () pipeToChan h chan = do - line <- hGetLineSafe h + line <- hGetLine h atomically $ writeTChan chan line writer :: String -> Separator -> Length -> Rate -> TChan String -> (String -> IO ()) -> IO () diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Bright.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Bright.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Bright.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Bright.hs 2020-08-22 18:45:20.000000000 +0200 @@ -14,7 +14,6 @@ module Xmobar.Plugins.Monitors.Bright (brightConfig, runBright) where -import Control.Applicative ((<$>)) import Control.Exception (SomeException, handle) import qualified Data.ByteString.Lazy.Char8 as B import System.FilePath ((</>)) @@ -89,4 +88,3 @@ return (currVal / maxVal) where grab f = handle handler (read . B.unpack <$> B.readFile f) handler = const (return 0) :: SomeException -> IO Float - diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Common/Output.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Common/Output.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Common/Output.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Common/Output.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,9 @@ +{-#LANGUAGE RecordWildCards#-} + ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Strings --- Copyright: (c) 2018, 2019 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -37,6 +39,11 @@ , parseFloat , parseInt , stringParser + , pShowPercentsWithColors + , pShowPercentBar + , pShowVerticalBar + , pShowIconPattern + , pShowPercentWithColors ) where import Data.Char @@ -44,11 +51,64 @@ import qualified Data.ByteString.Lazy.Char8 as B import Numeric import Control.Monad (zipWithM) - +import Control.Monad.IO.Class (MonadIO(..)) import Xmobar.Plugins.Monitors.Common.Types type IconPattern = Int -> String +pShowVerticalBar :: (MonadIO m) => MonitorConfig -> Float -> Float -> m String +pShowVerticalBar p v x = pColorizeString p v [convert $ 100 * x] + where convert :: Float -> Char + convert val + | t <= 9600 = ' ' + | t > 9608 = chr 9608 + | otherwise = chr t + where t = 9600 + (round val `div` 12) + +pShowPercentsWithColors :: (MonadIO m) => MonitorConfig -> [Float] -> m [String] +pShowPercentsWithColors p fs = + do let fstrs = map (pFloatToPercent p) fs + temp = map (*100) fs + zipWithM (pShowWithColors p . const) fstrs temp + +pShowPercentWithColors :: (MonadIO m) => MonitorConfig -> Float -> m String +pShowPercentWithColors p f = fmap head $ pShowPercentsWithColors p [f] + +pShowPercentBar :: (MonadIO m) => MonitorConfig -> Float -> Float -> m String +pShowPercentBar p@MonitorConfig{..} v x = do + let len = min pBarWidth $ round (fromIntegral pBarWidth * x) + s <- pColorizeString p v (take len $ cycle pBarFore) + return $ s ++ take (pBarWidth - len) (cycle pBarBack) + +pShowWithColors :: (Num a, Ord a, MonadIO m) => MonitorConfig -> (a -> String) -> a -> m String +pShowWithColors p f x = do + let str = pShowWithPadding p (f x) + pColorizeString p x str + +pColorizeString :: (Num a, Ord a, MonadIO m) => MonitorConfig -> a -> String -> m String +pColorizeString p x s = do + let col = pSetColor p s + [ll,hh] = map fromIntegral $ sort [pLow p, pHigh p] -- consider high < low + pure $ head $ [col pHighColor | x > hh ] ++ + [col pNormalColor | x > ll ] ++ + [col pLowColor | True] + +pSetColor :: MonitorConfig -> String -> PSelector (Maybe String) -> String +pSetColor config str s = + do let a = getPConfigValue config s + case a of + Nothing -> str + Just c -> "<fc=" ++ c ++ ">" ++ str ++ "</fc>" + +pShowWithPadding :: MonitorConfig -> String -> String +pShowWithPadding MonitorConfig {..} = + padString pMinWidth pMaxWidth pPadChars pPadRight pMaxWidthEllipsis + +pFloatToPercent :: MonitorConfig -> Float -> String +pFloatToPercent MonitorConfig{..} n = let p = showDigits 0 (n * 100) + ps = if pUseSuffix then "%" else "" + in padString pPpad pPpad pPadChars pPadRight "" p ++ ps + parseIconPattern :: String -> IconPattern parseIconPattern path = let spl = splitOnPercent path @@ -161,9 +221,12 @@ bb <- getConfigValue barBack bf <- getConfigValue barFore bw <- getConfigValue barWidth - let len = min bw $ round (fromIntegral bw * x) - s <- colorizeString v (take len $ cycle bf) - return $ s ++ take (bw - len) (cycle bb) + let c = bw < 1 + w = if c then length bf else bw + len = min w $ round (fromIntegral w * x) + bfs = if c then [bf !! max 0 (len - 1)] else take len $ cycle bf + s <- colorizeString v bfs + return $ s ++ if c then "" else take (bw - len) (cycle bb) showIconPattern :: Maybe IconPattern -> Float -> Monitor String showIconPattern Nothing _ = return "" @@ -171,6 +234,15 @@ where convert val | t <= 0 = 0 | t > 8 = 8 + | otherwise = t + where t = round val `div` 12 + +pShowIconPattern :: Maybe IconPattern -> Float -> IO String +pShowIconPattern Nothing _ = return "" +pShowIconPattern (Just str) x = return $ str $ convert $ 100 * x + where convert val + | t <= 0 = 0 + | t > 8 = 8 | otherwise = t where t = round val `div` 12 diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Common/Parsers.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Common/Parsers.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Common/Parsers.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Common/Parsers.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,10 @@ +{-#LANGUAGE RecordWildCards#-} +{-#LANGUAGE ScopedTypeVariables#-} + ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Parsers --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -25,15 +28,47 @@ , parseTemplate , parseTemplate' , parseOptsWith + , templateParser + , runExportParser + , runTemplateParser + , pureParseTemplate ) where import Xmobar.Plugins.Monitors.Common.Types -import Control.Applicative ((<$>)) import qualified Data.Map as Map import System.Console.GetOpt (ArgOrder(Permute), OptDescr, getOpt) import Text.ParserCombinators.Parsec +runTemplateParser :: MonitorConfig -> IO [(String, String, String)] +runTemplateParser MonitorConfig{..} = runP templateParser pTemplate + +runExportParser :: [String] -> IO [(String, [(String, String,String)])] +runExportParser [] = pure [] +runExportParser (x:xs) = do + s <- runP templateParser x + rest <- runExportParser xs + pure $ (x,s):rest + +pureParseTemplate :: MonitorConfig -> TemplateInput -> IO String +pureParseTemplate MonitorConfig{..} TemplateInput{..} = + do let m = let expSnds :: [([(String, String, String)], String)] = zip (map snd temAllTemplate) temMonitorValues + in Map.fromList $ zip (map fst temAllTemplate) expSnds + s <- minCombine m temInputTemplate + let (n, s') = if pMaxTotalWidth > 0 && length s > pMaxTotalWidth + then trimTo (pMaxTotalWidth - length pMaxTotalWidthEllipsis) "" s + else (1, s) + return $ if n > 0 then s' else s' ++ pMaxTotalWidthEllipsis + +minCombine :: Map.Map String ([(String, String, String)], String) -> [(String, String, String)] -> IO String +minCombine _ [] = return [] +minCombine m ((s,ts,ss):xs) = + do next <- minCombine m xs + str <- case Map.lookup ts m of + Nothing -> return $ "<" ++ ts ++ ">" + Just (s',r) -> let f "" = r; f n = n; in f <$> minCombine m s' + pure $ s ++ str ++ ss ++ next + runP :: Parser [a] -> String -> IO [a] runP p i = case parse p "" i of diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Common/Run.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Common/Run.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Common/Run.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Common/Run.hs 2020-08-22 18:45:20.000000000 +0200 @@ -22,6 +22,9 @@ , runML , runMLD , getArgvs + , doArgs + , computeMonitorConfig + , pluginOptions ) where import Control.Exception (SomeException,handle) @@ -32,11 +35,11 @@ import Xmobar.Plugins.Monitors.Common.Types import Xmobar.Run.Exec (doEveryTenthSeconds) -options :: [OptDescr Opts] -options = +pluginOptions :: [OptDescr Opts] +pluginOptions = [ - Option "H" ["High"] (ReqArg High "number") "The high threshold" - , Option "L" ["Low"] (ReqArg Low "number") "The low threshold" + Option ['H'] ["High"] (ReqArg High "number") "The high threshold" + , Option ['L'] ["Low"] (ReqArg Low "number") "The low threshold" , Option "h" ["high"] (ReqArg HighColor "color number") "Color for the high threshold: ex \"#FF0000\"" , Option "n" ["normal"] (ReqArg NormalColor "color number") "Color for the normal threshold: ex \"#00FF00\"" , Option "l" ["low"] (ReqArg LowColor "color number") "Color for the low threshold: ex \"#0000FF\"" @@ -61,16 +64,18 @@ -- | Get all argument values out of a list of arguments. getArgvs :: [String] -> [String] getArgvs args = - case getOpt Permute options args of + case getOpt Permute pluginOptions args of (_, n, [] ) -> n (_, _, errs) -> errs + + doArgs :: [String] -> ([String] -> Monitor String) -> ([String] -> Monitor Bool) -> Monitor String doArgs args action detect = - case getOpt Permute options args of + case getOpt Permute pluginOptions args of (o, n, []) -> do doConfigOptions o ready <- detect n if ready @@ -139,3 +144,18 @@ showException :: SomeException -> String showException = ("error: "++) . show . flip asTypeOf undefined + +computeMonitorConfig :: [String] -> IO MConfig -> IO MonitorConfig +computeMonitorConfig args mconfig = do + newConfig <- getMConfig args mconfig + getMonitorConfig newConfig + +getMConfig :: [String] -> IO MConfig -> IO MConfig +getMConfig args mconfig = do + config <- mconfig + runReaderT (updateOptions args >> ask) config + +updateOptions :: [String] -> Monitor () +updateOptions args= case getOpt Permute pluginOptions args of + (o, _, []) -> doConfigOptions o + _ -> return () diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Common/Types.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Common/Types.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Common/Types.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Common/Types.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,3 +1,5 @@ +{-#LANGUAGE RecordWildCards#-} + ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Types @@ -20,9 +22,14 @@ , Opts (..) , Selector , setConfigValue - , getConfigValue , mkMConfig , io + , MonitorConfig (..) + , getPConfigValue + , getConfigValue + , getMonitorConfig + , PSelector + , TemplateInput(..) ) where import Control.Monad.Reader (ReaderT, ask, liftIO) @@ -34,6 +41,12 @@ io :: IO a -> Monitor a io = liftIO +data TemplateInput = TemplateInput { + temMonitorValues :: [String], + temInputTemplate :: [(String, String, String)], + temAllTemplate :: [(String, [(String, String, String)])] + } + data MConfig = MC { normalColor :: IORef (Maybe String) , low :: IORef Int @@ -58,8 +71,63 @@ , maxTotalWidthEllipsis :: IORef String } +data MonitorConfig = + MonitorConfig + { pNormalColor :: Maybe String + , pLow :: Int + , pLowColor :: Maybe String + , pHigh :: Int + , pHighColor :: Maybe String + , pTemplate :: String + , pExport :: [String] + , pPpad :: Int + , pDecDigits :: Int + , pMinWidth :: Int + , pMaxWidth :: Int + , pMaxWidthEllipsis :: String + , pPadChars :: String + , pPadRight :: Bool + , pBarBack :: String + , pBarFore :: String + , pBarWidth :: Int + , pUseSuffix :: Bool + , pNaString :: String + , pMaxTotalWidth :: Int + , pMaxTotalWidthEllipsis :: String + } + deriving (Eq, Ord) + +getMonitorConfig :: MConfig -> IO MonitorConfig +getMonitorConfig MC{..} = do + pNormalColor <- readIORef normalColor + pLow <- readIORef low + pLowColor <- readIORef lowColor + pHigh <- readIORef high + pHighColor <- readIORef highColor + pTemplate <- readIORef template + pExport <- readIORef export + pPpad <- readIORef ppad + pDecDigits <- readIORef decDigits + pMinWidth <- readIORef minWidth + pMaxWidth <- readIORef maxWidth + pMaxWidthEllipsis <- readIORef maxWidthEllipsis + pPadChars <- readIORef padChars + pPadRight <- readIORef padRight + pBarBack <- readIORef barBack + pBarFore <- readIORef barFore + pBarWidth <- readIORef barWidth + pUseSuffix <- readIORef useSuffix + pNaString <- readIORef naString + pMaxTotalWidth <- readIORef maxTotalWidth + pMaxTotalWidthEllipsis <- readIORef maxTotalWidthEllipsis + pure $ MonitorConfig {..} + -- | from 'http:\/\/www.haskell.org\/hawiki\/MonadState' type Selector a = MConfig -> IORef a +type PSelector a = MonitorConfig -> a + +psel :: MonitorConfig -> PSelector a -> a +psel value accessor = accessor value sel :: Selector a -> Monitor a sel s = @@ -78,6 +146,9 @@ getConfigValue :: Selector a -> Monitor a getConfigValue = sel +getPConfigValue :: MonitorConfig -> PSelector a -> a +getPConfigValue = psel + mkMConfig :: String -> [String] -> IO MConfig diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Cpu.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Cpu.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Cpu.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Cpu.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,3 +1,5 @@ +{-#LANGUAGE RecordWildCards#-} + ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Cpu @@ -13,12 +15,23 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Monitors.Cpu (startCpu) where +module Xmobar.Plugins.Monitors.Cpu + ( startCpu + , runCpu + , cpuConfig + , CpuDataRef + , CpuOpts + , CpuArguments + , parseCpu + , getArguments + ) where import Xmobar.Plugins.Monitors.Common import qualified Data.ByteString.Lazy.Char8 as B import Data.IORef (IORef, newIORef, readIORef, writeIORef) import System.Console.GetOpt +import Xmobar.App.Timer (doEveryTenthSeconds) +import Control.Monad (void) newtype CpuOpts = CpuOpts { loadIconPattern :: Maybe IconPattern @@ -35,48 +48,206 @@ o { loadIconPattern = Just $ parseIconPattern x }) "") "" ] +barField :: String +barField = "bar" + +vbarField :: String +vbarField = "vbar" + +ipatField :: String +ipatField = "ipat" + +totalField :: String +totalField = "total" + +userField :: String +userField = "user" + +niceField :: String +niceField = "nice" + +systemField :: String +systemField = "system" + +idleField :: String +idleField = "idle" + +iowaitField :: String +iowaitField = "iowait" + cpuConfig :: IO MConfig -cpuConfig = mkMConfig - "Cpu: <total>%" - ["bar","vbar","ipat","total","user","nice","system","idle","iowait"] +cpuConfig = + mkMConfig + "Cpu: <total>%" + [ barField + , vbarField + , ipatField + , totalField + , userField + , niceField + , systemField + , idleField + , iowaitField + ] type CpuDataRef = IORef [Int] +-- Details about the fields here: https://www.kernel.org/doc/Documentation/filesystems/proc.txt cpuData :: IO [Int] -cpuData = cpuParser `fmap` B.readFile "/proc/stat" +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 (read . B.unpack) . tail . B.words . head . B.lines +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 [Float] +parseCpu :: CpuDataRef -> IO CpuData parseCpu cref = do a <- readIORef cref b <- cpuData writeIORef cref b let dif = zipWith (-) b a tot = fromIntegral $ sum dif - percent = map ((/ tot) . fromIntegral) dif - return percent - -formatCpu :: CpuOpts -> [Float] -> Monitor [String] -formatCpu _ [] = return $ replicate 8 "" -formatCpu opts xs = do - let t = sum $ take 3 xs - b <- showPercentBar (100 * t) t - v <- showVerticalBar (100 * t) t - d <- showIconPattern (loadIconPattern opts) t - ps <- showPercentsWithColors (t:xs) - return (b:v:d:ps) - -runCpu :: CpuDataRef -> [String] -> Monitor String -runCpu cref argv = - do c <- io (parseCpu cref) - opts <- io $ parseOptsWith options defaultOpts argv - l <- formatCpu opts c - parseTemplate l + 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 + } deriving (Eq, Ord, Show) + +data ShouldCompute = Compute | Skip deriving (Eq, Ord, Show) + +formatField :: MonitorConfig -> CpuOpts -> CpuData -> Field -> IO String +formatField cpuParams cpuOpts cpuInfo@CpuData {..} Field {..} + | fieldName == barField = + if fieldCompute == Compute + then pShowPercentBar cpuParams (100 * cpuTotal) cpuTotal + else pure [] + | fieldName == vbarField = + if fieldCompute == Compute + then pShowVerticalBar cpuParams (100 * cpuTotal) cpuTotal + else pure [] + | fieldName == ipatField = + if fieldCompute == Compute + then pShowIconPattern (loadIconPattern cpuOpts) cpuTotal + else pure [] + | otherwise = + if fieldCompute == Compute + then pShowPercentWithColors cpuParams (getFieldValue fieldName cpuInfo) + else pure [] + +getFieldValue :: String -> CpuData -> Float +getFieldValue field CpuData{..} + | field == barField = cpuTotal + | field == vbarField = cpuTotal + | field == ipatField = cpuTotal + | field == totalField = cpuTotal + | field == userField = cpuUser + | field == niceField = cpuNice + | field == systemField = cpuSystem + | field == idleField = cpuIdle + | otherwise = cpuIowait + +computeFields :: [String] -> [String] -> [Field] +computeFields [] _ = [] +computeFields (x:xs) inputFields = + if x `elem` inputFields + then (Field {fieldName = x, fieldCompute = Compute}) : + computeFields xs inputFields + else (Field {fieldName = x, fieldCompute = Skip}) : + computeFields xs inputFields + +formatCpu :: CpuArguments -> CpuData -> IO [String] +formatCpu CpuArguments{..} cpuInfo = do + strs <- mapM (formatField cpuParams cpuOpts cpuInfo) cpuFields + pure $ filter (not . null) strs + +getInputFields :: CpuArguments -> [String] +getInputFields CpuArguments{..} = map (\(_,f,_) -> f) cpuInputTemplate + +optimizeAllTemplate :: CpuArguments -> CpuArguments +optimizeAllTemplate args@CpuArguments {..} = + let inputFields = getInputFields args + allTemplates = + filter (\(field, _) -> field `elem` inputFields) cpuAllTemplate + in args {cpuAllTemplate = allTemplates} + +data CpuArguments = + CpuArguments + { cpuDataRef :: !CpuDataRef + , cpuParams :: !MonitorConfig + , cpuArgs :: ![String] + , cpuOpts :: !CpuOpts + , cpuInputTemplate :: ![(String, String, String)] -- [("Cpu: ","total","% "),("","user","%")] + , cpuAllTemplate :: ![(String, [(String, String, String)])] -- [("bar",[]),("vbar",[]),("ipat",[]),("total",[]),...] + , cpuFields :: ![Field] + } + + +getArguments :: [String] -> IO CpuArguments +getArguments cpuArgs = do + initCpuData <- cpuData + cpuDataRef <- newIORef initCpuData + void $ parseCpu cpuDataRef + cpuParams <- computeMonitorConfig cpuArgs cpuConfig + cpuInputTemplate <- runTemplateParser cpuParams + cpuAllTemplate <- runExportParser (pExport cpuParams) + nonOptions <- + case getOpt Permute pluginOptions cpuArgs of + (_, n, []) -> pure n + (_, _, errs) -> error $ "getArguments: " <> show errs + cpuOpts <- + case getOpt Permute options nonOptions of + (o, _, []) -> pure $ foldr id defaultOpts o + (_, _, errs) -> error $ "getArguments options: " <> show errs + let cpuFields = + computeFields + (map fst cpuAllTemplate) + (map (\(_, f, _) -> f) cpuInputTemplate) + pure $ optimizeAllTemplate CpuArguments {..} + + +runCpu :: CpuArguments -> IO String +runCpu args@CpuArguments {..} = do + cpuValue <- parseCpu cpuDataRef + temMonitorValues <- formatCpu args cpuValue + let templateInput = + TemplateInput + { temInputTemplate = cpuInputTemplate + , temAllTemplate = cpuAllTemplate + , .. + } + pureParseTemplate cpuParams templateInput startCpu :: [String] -> Int -> (String -> IO ()) -> IO () -startCpu a r cb = do - cref <- newIORef [] - _ <- parseCpu cref - runM a cpuConfig (runCpu cref) r cb +startCpu args refreshRate cb = do + cpuArgs <- getArguments args + doEveryTenthSeconds refreshRate (runCpu cpuArgs >>= cb) diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/MPD.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/MPD.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/MPD.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/MPD.hs 2020-08-22 18:45:20.000000000 +0200 @@ -20,14 +20,17 @@ import System.Console.GetOpt import qualified Network.MPD as M import Control.Concurrent (threadDelay) +import Control.Monad.Except (catchError) + +templateVars :: [String] +templateVars = [ "bar", "vbar", "ipat", "state", "statei", "volume", "length" + , "lapsed", "remaining", "plength", "ppos", "flags", "file" + , "name", "artist", "composer", "performer" + , "album", "title", "track", "genre", "date" + ] mpdConfig :: IO MConfig -mpdConfig = mkMConfig "MPD: <state>" - [ "bar", "vbar", "ipat", "state", "statei", "volume", "length" - , "lapsed", "remaining", "plength", "ppos", "flags", "file" - , "name", "artist", "composer", "performer" - , "album", "title", "track", "genre", "date" - ] +mpdConfig = mkMConfig "MPD: <state>" templateVars data MOpts = MOpts { mPlaying :: String @@ -60,7 +63,8 @@ ] withMPD :: MOpts -> M.MPD a -> IO (M.Response a) -withMPD opts = M.withMPD_ (mHost opts) (mPort opts) +withMPD opts a = + M.withMPD_ (mHost opts) (mPort opts) a `catchError` (\_ -> return (Left M.NoMPD)) runMPD :: [String] -> Monitor String runMPD args = do @@ -74,7 +78,7 @@ mpdWait = do status <- M.withMPD $ M.idle [M.PlayerS, M.MixerS, M.OptionsS] case status of - Left _ -> threadDelay 10000000 + Left _ -> threadDelay 5000 _ -> return () mpdReady :: [String] -> Monitor Bool @@ -91,19 +95,21 @@ parseMPD :: M.Response M.Status -> M.Response (Maybe M.Song) -> MOpts -> Monitor [String] -parseMPD (Left e) _ _ = return $ show e:replicate 19 "" +parseMPD (Left _) _ _ = return $ "N/A": repeat "" parseMPD (Right st) song opts = do songData <- parseSong song bar <- showPercentBar (100 * b) b vbar <- showVerticalBar (100 * b) b ipat <- showIconPattern (mLapsedIconPattern opts) b - return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos, flags] ++ songData + return $ [bar, vbar, ipat, ss, si, vol, len, lap, remain, plen, ppos, flags] + ++ songData where s = M.stState st ss = show s si = stateGlyph s opts vol = int2str $ fromMaybe 0 (M.stVolume st) (p, t) = fromMaybe (0, 0) (M.stTime st) - [lap, len, remain] = map showTime [floor p, floor t, max 0 (floor t - floor p)] + [lap, len, remain] = map showTime + [floor p, floor t, max 0 (floor t - floor p)] b = if t > 0 then realToFrac $ p / t else 0 plen = int2str $ M.stPlaylistLength st ppos = maybe "" (int2str . (+1)) $ M.stSongPos st diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Mpris.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Mpris.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Mpris.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Mpris.hs 2020-08-22 18:45:20.000000000 +0200 @@ -28,7 +28,8 @@ import Control.Arrow ((***)) import Data.Maybe ( fromJust ) import Data.Int ( Int32, Int64 ) -import System.IO.Unsafe (unsafePerformIO) +import Data.Word ( Word32 ) +import System.IO.Unsafe ( unsafePerformIO ) import Control.Exception (try) @@ -127,21 +128,25 @@ where hh = (n `div` 60) `div` 60 mm = (n `div` 60) `mod` 60 ss = n `mod` 60 + pInt str v = let num = fromVar v in + case str of + "mtime" -> formatTime (num `div` 1000) + "tracknumber" -> printf "%02d" num + "mpris:length" -> formatTime (num `div` 1000000) + "xesam:trackNumber" -> printf "%02d" num + _ -> (show::Int32 -> String) num + pw32 v = printf "%02d" (fromVar v::Word32) + plen str v = let num = fromVar v in + case str of + "mpris:length" -> formatTime (num `div` 1000000) + _ -> (show::Int64 -> String) num getStr str = case lookup str md of Nothing -> "" Just v -> case variantType v of TypeString -> fromVar v - TypeInt32 -> let num = fromVar v in - case str of - "mtime" -> formatTime (num `div` 1000) - "tracknumber" -> printf "%02d" num - "mpris:length" -> formatTime (num `div` 1000000) - "xesam:trackNumber" -> printf "%02d" num - _ -> (show::Int32 -> String) num - TypeInt64 -> let num = fromVar v in - case str of - "mpris:length" -> formatTime (num `div` 1000000) - _ -> (show::Int64 -> String) num + TypeInt32 -> pInt str v + TypeWord32 -> pw32 v + TypeInt64 -> plen str v TypeArray TypeString -> let x = arrayItems (fromVar v) in if null x then "" else fromVar (head x) diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/MultiCoreTemp.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.MultiCoreTemp --- Copyright : (c) 2019 Felix Springer +-- Copyright : (c) 2019, 2020 Felix Springer -- License : BSD-style (see LICENSE) -- -- Maintainer : Felix Springer <felixspringer149@gmail.com> @@ -26,6 +26,7 @@ , avgIconPattern :: Maybe IconPattern , mintemp :: Float , maxtemp :: Float + , hwMonitorPath :: Maybe String } -- | Set default Options. @@ -34,6 +35,7 @@ , avgIconPattern = Nothing , mintemp = 0 , maxtemp = 100 + , hwMonitorPath = Nothing } -- | Apply configured Options. @@ -58,6 +60,11 @@ (\ arg opts -> opts { maxtemp = read arg }) "") "" + , Option [] ["hwmon-path"] + (ReqArg + (\ arg opts -> opts { hwMonitorPath = Just arg }) + "") + "" ] -- | Generate Config with a default template and options. @@ -68,41 +75,50 @@ , "avg" , "avgpc" , "avgbar" , "avgvbar" , "avgipat" ] ++ map (("core" ++) . show) [0 :: Int ..] + -- | Returns the first coretemp.N path found. -coretempPath :: IO String +coretempPath :: IO (Maybe String) coretempPath = do xs <- filterM doesDirectoryExist ps - let x = head xs - return x - where ps = [ "/sys/bus/platform/devices/coretemp." ++ show (x :: Int) ++ "/" | x <- [0..9] ] - --- | Returns the first hwmonN path found. -hwmonPath :: IO String -hwmonPath = do p <- coretempPath - xs <- filterM doesDirectoryExist [ p ++ "hwmon/hwmon" ++ show (x :: Int) ++ "/" | x <- [0..9] ] - let x = head xs - return x + return (if null xs then Nothing else Just $ head xs) + where ps = [ "/sys/bus/platform/devices/coretemp." ++ show (x :: Int) ++ "/" + | x <- [0..9] ] + +-- | Returns the first hwmonN in coretemp path found or the ones in sys/class. +hwmonPaths :: IO [String] +hwmonPaths = do p <- coretempPath + let (sc, path) = case p of + Just s -> (False, s) + Nothing -> (True, "/sys/class/") + let cps = [ path ++ "hwmon/hwmon" ++ show (x :: Int) ++ "/" + | x <- [0..9] ] + ecps <- filterM doesDirectoryExist cps + return $ if sc || null ecps then ecps else [head ecps] -- | Checks Labels, if they refer to a core and returns Strings of core- -- temperatures. -corePaths :: IO [String] -corePaths = do p <- hwmonPath - ls <- filterM doesFileExist [ p ++ "temp" ++ show (x :: Int) ++ "_label" | x <- [0..9] ] - cls <- filterM isLabelFromCore ls - return $ map labelToCore cls +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 ] + ls <- filterM doesFileExist cps + cls <- filterM isLabelFromCore ls + return $ map labelToCore cls -- | Checks if Label refers to a core. isLabelFromCore :: FilePath -> IO Bool isLabelFromCore p = do a <- readFile p - return $ take 4 a == "Core" + return $ take 4 a `elem` ["Core", "Tdie", "Tctl"] -- | Transform a path to Label to a path to core-temperature. labelToCore :: FilePath -> FilePath labelToCore = (++ "input") . reverse . drop 5 . reverse -- | Reads core-temperatures as data from the system. -cTData :: IO [Float] -cTData = do fps <- corePaths - traverse readSingleFile fps +cTData :: Maybe String -> IO [Float] +cTData p = do fps <- corePaths p + traverse readSingleFile fps where readSingleFile :: FilePath -> IO Float readSingleFile s = do a <- readFile s return $ parseContent a @@ -110,10 +126,10 @@ parseContent = read . head . lines -- | Transforms data of temperatures into temperatures of degree Celsius. -parseCT :: IO [Float] -parseCT = do rawCTs <- cTData - let normalizedCTs = map (/ 1000) rawCTs :: [Float] - return normalizedCTs +parseCT :: CTOpts -> IO [Float] +parseCT opts = do rawCTs <- cTData (hwMonitorPath opts) + let normalizedCTs = map (/ 1000) rawCTs :: [Float] + return normalizedCTs -- | Performs calculation for maximum and average. -- Sets up Bars and Values to be printed. @@ -150,8 +166,8 @@ runCT :: [String] -> Monitor String -runCT argv = do cTs <- io parseCT - opts <- io $ parseOptsWith options defaultOpts argv +runCT argv = do opts <- io $ parseOptsWith options defaultOpts argv + cTs <- io $ parseCT opts l <- formatCT opts cTs parseTemplate l diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/MultiCpu.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/MultiCpu.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/MultiCpu.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/MultiCpu.hs 2020-08-22 18:45:20.000000000 +0200 @@ -15,7 +15,6 @@ module Xmobar.Plugins.Monitors.MultiCpu (startMultiCpu) where import Xmobar.Plugins.Monitors.Common -import Control.Applicative ((<$>)) import qualified Data.ByteString.Lazy.Char8 as B import Data.List (isPrefixOf, transpose, unfoldr) import Data.IORef (IORef, newIORef, readIORef, writeIORef) diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Net.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Net.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Net.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Net.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Net --- Copyright : (c) 2011, 2012, 2013, 2014, 2017 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2011, 2012, 2013, 2014, 2017, 2020 Jose Antonio Ortega Ruiz -- (c) 2007-2010 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -23,7 +23,6 @@ import Xmobar.Plugins.Monitors.Common import Data.IORef (IORef, newIORef, readIORef, writeIORef) -import Data.Monoid ((<>)) import Data.Time.Clock (UTCTime, getCurrentTime, diffUTCTime) import Data.Word (Word64) import Control.Monad (forM, filterM) @@ -49,6 +48,7 @@ { rxIconPattern :: Maybe IconPattern , txIconPattern :: Maybe IconPattern , onlyDevList :: Maybe DevList + , upIndicator :: String } defaultOpts :: NetOpts @@ -56,6 +56,7 @@ { rxIconPattern = Nothing , txIconPattern = Nothing , onlyDevList = Nothing + , upIndicator = "+" } options :: [OptDescr (NetOpts -> NetOpts)] @@ -64,6 +65,7 @@ o { rxIconPattern = Just $ parseIconPattern x }) "") "" , Option "" ["tx-icon-pattern"] (ReqArg (\x o -> o { txIconPattern = Just $ parseIconPattern x }) "") "" + , Option "" ["up"] (ReqArg (\x o -> o { upIndicator = x }) "") "" , Option "" ["devices"] (ReqArg (\x o -> o { onlyDevList = Just $ parseDevList x }) "") "" ] @@ -103,7 +105,7 @@ netConfig :: IO MConfig netConfig = mkMConfig "<dev>: <rx>KB|<tx>KB" -- template - ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat"] -- available replacements + ["dev", "rx", "tx", "rxbar", "rxvbar", "rxipat", "txbar", "txvbar", "txipat", "up"] -- available replacements operstateDir :: String -> FilePath operstateDir d = "/sys/class/net" </> d </> "operstate" @@ -160,7 +162,7 @@ N d (ND r t) -> do (rx, rb, rvb, ripat) <- formatNet (rxIconPattern opts) r (tx, tb, tvb, tipat) <- formatNet (txIconPattern opts) t - parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat] + parseTemplate [d,rx,tx,rb,rvb,ripat,tb,tvb,tipat, upIndicator opts] N _ NI -> return "" NA -> getConfigValue naString diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/UVMeter.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/UVMeter.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/UVMeter.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/UVMeter.hs 2020-08-22 18:45:20.000000000 +0200 @@ -21,14 +21,11 @@ import Network.HTTP.Conduit ( Manager , httpLbs - , managerConnCount - , newManager , parseRequest , responseBody - , tlsManagerSettings ) +import Network.HTTP.Client.TLS (getGlobalManager) import Data.ByteString.Lazy.Char8 as B -import Data.Maybe (fromMaybe) import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option)) import Text.Read (readMaybe) import Text.Parsec @@ -66,12 +63,9 @@ uvURL = "https://uvdata.arpansa.gov.au/xml/uvvalues.xml" -- | Get the UV data from the given url. -getData :: Maybe Manager -> IO String -getData uvMan = CE.catch - (do man <- flip fromMaybe uvMan <$> mkManager - -- Create a new manager if none was present or the user does not want to - -- use one, otherwise use the provided manager. - request <- parseRequest uvURL +getData ::Manager -> IO String +getData man = CE.catch + (do request <- parseRequest uvURL res <- httpLbs request man return $ B.unpack $ responseBody res) errHandler @@ -105,15 +99,13 @@ -> Int -- ^ Update rate -> (String -> IO ()) -> IO () -startUVMeter station args rate cb = do - opts <- parseOptsWith options defaultOpts (getArgvs args) - uvMan <- tryMakeManager opts - runM (station : args) uvConfig (runUVMeter uvMan) rate cb - -runUVMeter :: Maybe Manager -> [String] -> Monitor String -runUVMeter _ [] = return "N.A." -runUVMeter uvMan (s:_) = do - resp <- io $ getData uvMan +startUVMeter station args = runM (station : args) uvConfig runUVMeter + +runUVMeter :: [String] -> Monitor String +runUVMeter [] = return "N.A." +runUVMeter (s:_) = do + man <- io getGlobalManager + resp <- io $ getData man case textToXMLDocument resp of Right doc -> formatUVRating (getUVRating s doc) Left _ -> getConfigValue naString @@ -195,15 +187,3 @@ char '"' spaces return (Attribute (name, value)) - --- | Possibly create a new 'Manager', based upon the users preference. If one --- is created, this 'Manager' will be used throughout the monitor. -tryMakeManager :: UVMeterOpts -> IO (Maybe Manager) -tryMakeManager opts = - if useManager opts - then Just <$> mkManager - else pure Nothing - --- | Create a new 'Manager' for managing network connections. -mkManager :: IO Manager -mkManager = newManager $ tlsManagerSettings {managerConnCount = 1} diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Volume.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Volume.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Volume.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Volume.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Volume --- Copyright : (c) 2011, 2013, 2015, 2018 Thomas Tuegel +-- Copyright : (c) 2011, 2013, 2015, 2018, 2020 Thomas Tuegel -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> @@ -21,10 +21,8 @@ , VolumeOpts ) where -import Control.Applicative ( (<$>), liftA3 ) +import Control.Applicative ( liftA3 ) import Control.Monad ( liftM2, liftM3, mplus ) -import Data.Maybe (fromMaybe) -import Data.Traversable (sequenceA) import Xmobar.Plugins.Monitors.Common import Sound.ALSA.Mixer import qualified Sound.ALSA.Exception as AE @@ -230,21 +228,23 @@ liftMonitor Nothing = unavailable liftMonitor (Just m) = m - channel' v r = AE.catch (getChannel FrontLeft v) (const $ return $ Just r) + channel' :: PerChannel a -> IO (Maybe a) + channel' v = AE.catch (getChannel FrontLeft v) (const (return Nothing)) - channel v r = channel' v r >>= \x -> return (x >>= Just . toInteger) + channel :: PerChannel CLong -> IO (Maybe Integer) + channel v = fmap (fmap toInteger) (channel' v) getDB :: Maybe Volume -> IO (Maybe Integer) getDB Nothing = return Nothing - getDB (Just v) = channel (dB v) 0 + getDB (Just v) = channel (dB v) getVal :: Maybe Volume -> IO (Maybe Integer) getVal Nothing = return Nothing - getVal (Just v) = channel (value v) 0 + getVal (Just v) = channel (value v) getSw :: Maybe Switch -> IO (Maybe Bool) getSw Nothing = return Nothing - getSw (Just s) = channel' s False + getSw (Just s) = channel' s getFormatDB :: VolumeOpts -> Maybe Integer -> Monitor String getFormatDB _ Nothing = unavailable @@ -257,6 +257,5 @@ -- | Determine whether the volume is off based on the value of 'sw' from -- 'runVolumeWith'. - isVolOff = not . fromMaybe False - + isVolOff = (Just True /=) unavailable = getConfigValue naString diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Weather.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Weather.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Weather.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Weather.hs 2020-08-22 18:45:20.000000000 +0200 @@ -21,33 +21,30 @@ import qualified Data.ByteString.Lazy.Char8 as B import Data.Char (toLower) -import Data.Maybe (fromMaybe) import Network.HTTP.Conduit import Network.HTTP.Types.Status import Network.HTTP.Types.Method +import Network.HTTP.Client.TLS (getGlobalManager) import Text.ParserCombinators.Parsec import System.Console.GetOpt (ArgDescr(ReqArg), OptDescr(Option)) -- | Options the user may specify. -data WeatherOpts = WeatherOpts +newtype WeatherOpts = WeatherOpts { weatherString :: String - , useManager :: Bool } -- | Default values for options. defaultOpts :: WeatherOpts defaultOpts = WeatherOpts { weatherString = "" - , useManager = True } -- | Apply options. options :: [OptDescr (WeatherOpts -> WeatherOpts)] options = [ Option "w" ["weathers" ] (ReqArg (\s o -> o { weatherString = s }) "") "" - , Option "m" ["useManager"] (ReqArg (\b o -> o { useManager = read b }) "") "" ] weatherConfig :: IO MConfig @@ -213,12 +210,10 @@ stationUrl station = defUrl ++ station ++ ".TXT" -- | Get the decoded weather data from the given station. -getData :: Maybe Manager -> String -> IO String -getData weMan station = CE.catch - (do man <- flip fromMaybe weMan <$> mkManager - -- Create a new manager if none was present or the user does not want to - -- use one. - request <- parseUrlThrow $ stationUrl station +getData :: String -> IO String +getData station = CE.catch + (do request <- parseUrlThrow $ stationUrl station + man <- getGlobalManager res <- httpLbs request man return $ B.unpack $ responseBody res) errHandler @@ -261,11 +256,10 @@ -> IO () startWeather' sks station args rate cb = do opts <- parseOptsWith options defaultOpts (getArgvs args) - weRef <- tryMakeManager opts runMD (station : args) weatherConfig - (runWeather sks weRef opts) + (runWeather sks opts) rate weatherReady cb @@ -278,12 +272,11 @@ -- | Run a weather monitor. runWeather :: [(String, String)] -- ^ 'SkyConditionS' replacement strings - -> Maybe Manager -- ^ Whether to use a 'Manager' -> WeatherOpts -- ^ Weather specific options -> [String] -- ^ User supplied arguments -> Monitor String -runWeather sks weMan opts args = do - d <- io $ getData weMan (head args) +runWeather sks opts args = do + d <- io $ getData (head args) i <- io $ runP parseData d formatWeather opts sks i @@ -293,7 +286,7 @@ let request = initRequest { method = methodHead } CE.catch - (do man <- mkManager + (do man <- getGlobalManager res <- httpLbs request man return $ checkResult $ responseStatus res) errHandler @@ -308,15 +301,3 @@ | statusIsServerError status = False | statusIsClientError status = False | otherwise = True - --- | Possibly create a new 'Manager', based upon the users preference. If one --- is created, this 'Manager' will be used throughout the monitor. -tryMakeManager :: WeatherOpts -> IO (Maybe Manager) -tryMakeManager opts = - if useManager opts - then Just <$> mkManager - else pure Nothing - --- | Create a new 'Manager' for managing network connections. -mkManager :: IO Manager -mkManager = newManager $ tlsManagerSettings { managerConnCount = 1 } diff -Nru xmobar-0.33/src/Xmobar/Plugins/Monitors/Wireless.hs xmobar-0.36/src/Xmobar/Plugins/Monitors/Wireless.hs --- xmobar-0.33/src/Xmobar/Plugins/Monitors/Wireless.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/Monitors/Wireless.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,4 +1,7 @@ -{-# LANGUAGE TypeApplications, CPP #-} +{-# LANGUAGE CPP #-} +#ifdef USE_NL80211 +{-# LANGUAGE TypeApplications #-} +#endif ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Wireless @@ -16,7 +19,6 @@ module Xmobar.Plugins.Monitors.Wireless (wirelessConfig, runWireless) where import System.Console.GetOpt -import Data.Maybe (fromMaybe) import Xmobar.Plugins.Monitors.Common @@ -26,7 +28,7 @@ import Control.Exception (bracket) import qualified Data.Map as M import GHC.Int (Int8) -import Data.Maybe (listToMaybe) +import Data.Maybe (listToMaybe, fromMaybe) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT) import Data.ByteString.Char8 (unpack) @@ -42,12 +44,12 @@ data IwData = IwData { wiEssid :: String, wiSignal :: Maybe Int, wiQuality :: Int } getWirelessInfo :: String -> IO IwData -getWirelessInfo ifname = do +getWirelessInfo ifname = bracket makeNL80211Socket (closeFd . getFd) (\s -> do iflist <- getInterfaceList s iwdata <- runMaybeT $ do ifidx <- MaybeT . return $ foldr (\(n, i) z -> - if (ifname == "" || ifname == n) then Just i else z) + if ifname == "" || ifname == n then Just i else z) Nothing iflist scanp <- liftIO (getConnectedWifi s ifidx) >>= @@ -63,13 +65,16 @@ return . unpack signal = staInfoFromPacket stap >>= staSignalMBM >>= return . fromIntegral @Int8 . fromIntegral - qlty = fromMaybe (-1) (round @Float . (/ 0.7) . (+ 110) . - clamp (-110) (-40) . fromIntegral <$> signal) + qlty = maybe (-1) (round @Float . (/ 0.7) . (+ 110) . + clamp (-110) (-40) . fromIntegral) signal MaybeT . return $ Just $ IwData ssid signal qlty return $ fromMaybe (IwData "" Nothing (-1)) iwdata) where rightToMaybe = either (const Nothing) Just - clamp lb up v = if v < lb then lb else if v > up then up else v + clamp lb up v + | v < lb = lb + | v > up = up + | otherwise = v #endif newtype WirelessOpts = WirelessOpts diff -Nru xmobar-0.33/src/Xmobar/Plugins/PipeReader.hs xmobar-0.36/src/Xmobar/Plugins/PipeReader.hs --- xmobar-0.33/src/Xmobar/Plugins/PipeReader.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/PipeReader.hs 2020-08-22 18:45:20.000000000 +0200 @@ -16,13 +16,11 @@ import System.IO import Xmobar.Run.Exec(Exec(..)) -import Xmobar.System.Utils(hGetLineSafe) import Xmobar.System.Environment(expandEnv) import System.Posix.Files import Control.Concurrent(threadDelay) import Control.Exception import Control.Monad(forever, unless) -import Control.Applicative ((<$>)) data PipeReader = PipeReader String String deriving (Read, Show) @@ -34,7 +32,7 @@ unless (null def) (cb def) checkPipe pipe h <- openFile pipe ReadWriteMode - forever (hGetLineSafe h >>= cb) + forever (hGetLine h >>= cb) where split c xs | c `elem` xs = let (pre, post) = span (c /=) xs in (pre, dropWhile (c ==) post) diff -Nru xmobar-0.33/src/Xmobar/Plugins/StdinReader.hs xmobar-0.36/src/Xmobar/Plugins/StdinReader.hs --- xmobar-0.33/src/Xmobar/Plugins/StdinReader.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Plugins/StdinReader.hs 2020-08-22 18:45:20.000000000 +0200 @@ -22,23 +22,30 @@ import System.Posix.Process import System.Exit import System.IO -import Control.Exception (SomeException(..), handle) import Xmobar.Run.Exec import Xmobar.X11.Actions (stripActions) -import Xmobar.System.Utils (hGetLineSafe) +import Xmobar.System.Utils (onSomeException) +import Control.Monad (when) data StdinReader = StdinReader | UnsafeStdinReader deriving (Read, Show) instance Exec StdinReader where start stdinReader cb = do - s <- handle (\(SomeException e) -> do hPrint stderr e; return "") - (hGetLineSafe stdin) - cb $ escape stdinReader s + -- The EOF check is necessary for certain systems + -- More details here https://github.com/jaor/xmobar/issues/442 eof <- isEOF - if eof - then exitImmediately ExitSuccess - else start stdinReader cb + 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 escape :: StdinReader -> String -> String escape StdinReader = stripActions diff -Nru xmobar-0.33/src/Xmobar/Run/Command.hs xmobar-0.36/src/Xmobar/Run/Command.hs --- xmobar-0.33/src/Xmobar/Run/Command.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Run/Command.hs 2020-08-22 18:45:20.000000000 +0200 @@ -20,8 +20,7 @@ import Control.Exception (handle, SomeException(..)) import System.Process import System.Exit -import System.IO (hClose) -import Xmobar.System.Utils (hGetLineSafe) +import System.IO (hClose, hGetLine) import Xmobar.Run.Exec @@ -47,7 +46,7 @@ exit <- waitForProcess p let closeHandles = hClose o >> hClose i >> hClose e getL = handle (\(SomeException _) -> return "") - (hGetLineSafe o) + (hGetLine o) case exit of ExitSuccess -> do str <- getL closeHandles diff -Nru xmobar-0.33/src/Xmobar/Run/Exec.hs xmobar-0.36/src/Xmobar/Run/Exec.hs --- xmobar-0.33/src/Xmobar/Run/Exec.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/Run/Exec.hs 2020-08-22 18:45:20.000000000 +0200 @@ -10,7 +10,7 @@ -- -- The 'Exec' class and the 'Command' data type. -- --- The 'Exec' class rappresents the executable types, whose constructors may +-- The 'Exec' class represents the executable types, whose constructors may -- appear in the 'Config.commands' field of the 'Config.Config' data type. -- -- The 'Command' data type is for OS commands to be run by xmobar diff -Nru xmobar-0.33/src/Xmobar/System/Environment.hs xmobar-0.36/src/Xmobar/System/Environment.hs --- xmobar-0.33/src/Xmobar/System/Environment.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/System/Environment.hs 2020-08-22 18:45:20.000000000 +0200 @@ -13,7 +13,6 @@ ----------------------------------------------------------------------------- module Xmobar.System.Environment(expandEnv) where -import Control.Applicative ((<$>)) import Data.Maybe (fromMaybe) import System.Environment (lookupEnv) diff -Nru xmobar-0.33/src/Xmobar/System/Utils.hs xmobar-0.36/src/Xmobar/System/Utils.hs --- xmobar-0.33/src/Xmobar/System/Utils.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/System/Utils.hs 2020-08-22 18:45:20.000000000 +0200 @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Utils --- Copyright: (c) 2010, 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2010, 2018, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: Jose A Ortega Ruiz <jao@gnu.org> @@ -17,27 +17,21 @@ ------------------------------------------------------------------------------ -module Xmobar.System.Utils (expandHome, changeLoop, hGetLineSafe) -where +module Xmobar.System.Utils + ( expandHome + , changeLoop + , onSomeException + , safeIndex + ) where import Control.Monad import Control.Concurrent.STM +import qualified Data.List.NonEmpty as NE +import Data.Maybe (fromMaybe) import System.Environment import System.FilePath -import System.IO - -#if defined XFT || defined UTF8 -import qualified System.IO as S (hGetLine) -#endif - -hGetLineSafe :: Handle -> IO String -#if defined XFT || defined UTF8 -hGetLineSafe = S.hGetLine -#else -hGetLineSafe = hGetLine -#endif - +import Control.Exception expandHome :: FilePath -> IO FilePath expandHome ('~':'/':path) = fmap (</> path) (getEnv "HOME") @@ -52,3 +46,26 @@ new <- s 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 + | otherwise = go i xs + where + go :: Int -> [a] -> Maybe a + go 0 (x:_) = Just x + go j (_:ys) = go (j - 1) ys + go _ [] = Nothing +{-# INLINE (!!?) #-} + +safeIndex :: NE.NonEmpty a -> Int -> a +safeIndex xs index = fromMaybe (NE.head xs) (NE.toList xs !!? index) diff -Nru xmobar-0.33/src/Xmobar/X11/Bitmap.hs xmobar-0.36/src/Xmobar/X11/Bitmap.hs --- xmobar-0.33/src/Xmobar/X11/Bitmap.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/X11/Bitmap.hs 2020-08-22 18:45:20.000000000 +0200 @@ -24,7 +24,7 @@ import System.FilePath ((</>)) import System.Mem.Weak ( addFinalizer ) import Xmobar.X11.ColorCache -import Xmobar.X11.Parsers (Widget(..)) +import Xmobar.X11.Parsers (TextRenderInfo(..), Widget(..)) import Xmobar.X11.Actions (Action) #ifdef XPM @@ -54,7 +54,7 @@ } updateCache :: Display -> Window -> Map FilePath Bitmap -> FilePath -> - [[(Widget, String, Int, Maybe [Action])]] -> IO (Map FilePath Bitmap) + [[(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 diff -Nru xmobar-0.33/src/Xmobar/X11/Draw.hs xmobar-0.36/src/Xmobar/X11/Draw.hs --- xmobar-0.33/src/Xmobar/X11/Draw.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/X11/Draw.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,9 +1,10 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TupleSections #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Draw --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2020 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -22,9 +23,10 @@ import Prelude hiding (lookup) import Control.Monad.IO.Class import Control.Monad.Reader -import Control.Monad (when) import Control.Arrow ((&&&)) -import Data.Map hiding (foldr, map, filter) +import Data.Map hiding ((\\), foldr, map, filter) +import Data.List ((\\)) +import qualified Data.List.NonEmpty as NE import Graphics.X11.Xlib hiding (textExtents, textWidth) import Graphics.X11.Xlib.Extras @@ -36,7 +38,8 @@ import Xmobar.X11.Text import Xmobar.X11.ColorCache import Xmobar.X11.Window (drawBorder) -import Xmobar.X11.Parsers (Widget(..)) +import Xmobar.X11.Parsers hiding (parseString) +import Xmobar.System.Utils (safeIndex) #ifdef XFT import Xmobar.X11.MinXft @@ -47,7 +50,7 @@ fi = fromIntegral -- | Draws in and updates the window -drawInWin :: Rectangle -> [[(Widget, String, Int, Maybe [Action])]] -> X () +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 @@ -55,7 +58,7 @@ strLn = liftIO . mapM getWidth iconW i = maybe 0 B.width (lookup i $ iconS r) getWidth (Text s,cl,i,_) = - textWidth d (fs!!i) s >>= \tw -> return (Text s,cl,i,fi tw) + 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 @@ -75,9 +78,9 @@ 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 + 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 @@ -101,53 +104,106 @@ | otherwise = return $ fi (ht `div` 2) - 1 printString :: Display -> Drawable -> XFont -> GC -> String -> String - -> Position -> Position -> String -> Int -> IO () -printString d p (Core fs) gc fc bc x y s a = do + -> 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 = +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 s al = +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 - drawXftRect draw bc' x (y - a) (1 + xglyphinfo_xOff gi) (a + d + 2) + 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 #endif -- | An easy way to print the stuff we need to print -printStrings :: Drawable -> GC -> [XFont] -> [Int] -> Position - -> Align -> [(Widget, String, Int, Position)] -> X () -printStrings _ _ _ _ _ _ [] = return () -printStrings dr gc fontlist voffs offs a sl@((s,c,i,l):xs) = do +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 = fontlist !! i + fontst = safeIndex fontlist i offset = case a of C -> (remWidth + offs) `div` 2 R -> remWidth L -> offs - (fc,bc) = case break (==',') c of + (fc,bc) = case break (==',') (tColorsString c) of (f,',':b) -> (f, b ) (f, _) -> (f, bgColor conf) - valign <- verticalOffset ht s (head fontlist) (voffs !! i) 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 t alph + (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)) - printStrings dr gc fontlist voffs (offs + l) a xs + 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" diff -Nru xmobar-0.33/src/Xmobar/X11/MinXft.hsc xmobar-0.36/src/Xmobar/X11/MinXft.hsc --- xmobar-0.33/src/Xmobar/X11/MinXft.hsc 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/X11/MinXft.hsc 2020-08-22 18:45:20.000000000 +0200 @@ -161,10 +161,16 @@ 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 (map fi (UTF8.encode string)) + withArrayLen (utf8EncodeString string) (\len ptr -> cXftDrawStringUtf8 d c f (fi x) (fi y) ptr (fi len)) drawXftString' :: AXftDraw -> diff -Nru xmobar-0.33/src/Xmobar/X11/Parsers.hs xmobar-0.36/src/Xmobar/X11/Parsers.hs --- xmobar-0.33/src/Xmobar/X11/Parsers.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/X11/Parsers.hs 2020-08-22 18:45:20.000000000 +0200 @@ -14,60 +14,86 @@ -- ----------------------------------------------------------------------------- -module Xmobar.X11.Parsers (parseString, Widget(..)) where +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 -type ColorString = 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, ColorString, FontIndex, Maybe [Action])] + -> IO [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] parseString c s = - case parse (stringParser (fgColor c) 0 Nothing) "" s of + case parse (stringParser ci 0 Nothing) "" s of Left _ -> return [(Text $ "Could not parse string: " ++ s - , fgColor c + , ci , 0 , Nothing)] Right x -> return (concat x) + where ci = TextRenderInfo (fgColor c) 0 0 [] -allParsers :: ColorString +allParsers :: TextRenderInfo -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, 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) - <|> colorParser f a + <|> try (boxParser c f a) + <|> colorParser c f a -- | Gets the string and combines the needed parsers -stringParser :: String -> FontIndex -> Maybe [Action] - -> Parser [[(Widget, ColorString, FontIndex, Maybe [Action])]] +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 :: String -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +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)] @@ -76,10 +102,10 @@ -- 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 :: ColorString +rawParser :: TextRenderInfo -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] + -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] rawParser c f a = do string "<raw=" lenstr <- many1 digit @@ -100,15 +126,15 @@ notFollowedBy $ try (e >> return '*') return x -iconParser :: String -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +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 :: String -> FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +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 "`")), @@ -126,21 +152,67 @@ toButtons = map (\x -> read [x]) -- | Parsers a string wrapped in a color specification. -colorParser :: FontIndex -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] -colorParser f a = do +colorParser :: TextRenderInfo -> FontIndex -> Maybe [Action] + -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] +colorParser (TextRenderInfo _ _ _ bs) f a = do c <- between (string "<fc=") (string ">") colors - s <- manyTill (allParsers c f a) (try $ string "</fc>") + 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 :: ColorString -> Maybe [Action] - -> Parser [(Widget, ColorString, FontIndex, Maybe [Action])] +fontParser :: TextRenderInfo -> Maybe [Action] + -> Parser [(Widget, TextRenderInfo, FontIndex, Maybe [Action])] fontParser c a = do f <- between (string "<fn=") (string ">") colors - s <- manyTill (allParsers c (read f) a) (try $ string "</fn>") + 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 '#') +colors = many1 (alphaNum <|> char ',' <|> char ':' <|> char '#') diff -Nru xmobar-0.33/src/Xmobar/X11/Types.hs xmobar-0.36/src/Xmobar/X11/Types.hs --- xmobar-0.33/src/Xmobar/X11/Types.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/X11/Types.hs 2020-08-22 18:45:20.000000000 +0200 @@ -20,6 +20,7 @@ import Graphics.X11.Xlib import Control.Monad.Reader import Data.Map +import qualified Data.List.NonEmpty as NE import Xmobar.X11.Bitmap import Xmobar.X11.Text @@ -33,7 +34,7 @@ XConf { display :: Display , rect :: Rectangle , window :: Window - , fontListS :: [XFont] + , fontListS :: NE.NonEmpty XFont , verticalOffsets :: [Int] , iconS :: Map FilePath Bitmap , config :: Config diff -Nru xmobar-0.33/src/Xmobar/X11/Window.hs xmobar-0.36/src/Xmobar/X11/Window.hs --- xmobar-0.33/src/Xmobar/X11/Window.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar/X11/Window.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Window --- Copyright : (c) 2011-18 Jose A. Ortega Ruiz +-- Copyright : (c) 2011-18, 20 Jose A. Ortega Ruiz -- : (c) 2012 Jochen Keil -- License : BSD-style (see LICENSE) -- @@ -16,7 +16,6 @@ module Xmobar.X11.Window where import Prelude -import Control.Applicative ((<$>)) import Control.Monad (when, unless) import Graphics.X11.Xlib hiding (textExtents) import Graphics.X11.Xlib.Extras diff -Nru xmobar-0.33/src/Xmobar.hs xmobar-0.36/src/Xmobar.hs --- xmobar-0.33/src/Xmobar.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/src/Xmobar.hs 2020-08-22 18:45:20.000000000 +0200 @@ -32,6 +32,7 @@ , module Xmobar.Plugins.DateZone #endif , module Xmobar.Plugins.EWMH + , module Xmobar.Plugins.HandleReader , module Xmobar.Plugins.Kbd , module Xmobar.Plugins.Locks #ifdef INOTIFY @@ -57,6 +58,7 @@ import Xmobar.Plugins.DateZone #endif import Xmobar.Plugins.EWMH +import Xmobar.Plugins.HandleReader import Xmobar.Plugins.Kbd import Xmobar.Plugins.Locks #ifdef INOTIFY diff -Nru xmobar-0.33/test/Xmobar/Plugins/Monitors/AlsaSpec.hs xmobar-0.36/test/Xmobar/Plugins/Monitors/AlsaSpec.hs --- xmobar-0.33/test/Xmobar/Plugins/Monitors/AlsaSpec.hs 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/test/Xmobar/Plugins/Monitors/AlsaSpec.hs 2020-08-22 18:45:20.000000000 +0200 @@ -1,9 +1,12 @@ {-# OPTIONS_GHC -Wall #-} +{-# LANGUAGE CPP #-} + module Xmobar.Plugins.Monitors.AlsaSpec ( main , spec ) where +#ifdef ALSA import Control.Concurrent import Control.Concurrent.Async import Control.Monad @@ -158,3 +161,11 @@ $ \(Just h) _ _ _ -> do hSetBuffering h LineBuffering body h +#else +-- These No-Op values are required for HSpec's test discovery. +main :: IO () +main = return () + +spec :: Monad m => m () +spec = return () +#endif diff -Nru xmobar-0.33/test/Xmobar/Plugins/Monitors/CpuSpec.hs xmobar-0.36/test/Xmobar/Plugins/Monitors/CpuSpec.hs --- xmobar-0.33/test/Xmobar/Plugins/Monitors/CpuSpec.hs 1970-01-01 01:00:00.000000000 +0100 +++ xmobar-0.36/test/Xmobar/Plugins/Monitors/CpuSpec.hs 2020-08-22 18:45:20.000000000 +0200 @@ -0,0 +1,41 @@ +module Xmobar.Plugins.Monitors.CpuSpec + ( + spec, main + ) where + +import Test.Hspec +import Xmobar.Plugins.Monitors.Common +import Xmobar.Plugins.Monitors.Cpu +import Data.List + +main :: IO () +main = hspec spec + +spec :: Spec +spec = + describe "CPU Spec" $ do + it "works with total template" $ + do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>%"] + cpuArgs <- getArguments args + cpuValue <- runCpu cpuArgs + cpuValue `shouldSatisfy` (\item -> "Cpu:" `isPrefixOf` item) + it "works with bar template" $ + do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>% <bar>"] + cpuArgs <- getArguments args + cpuValue <- runCpu cpuArgs + cpuValue `shouldSatisfy` (\item -> "::" `isSuffixOf` item) + it "works with no icon pattern template" $ + do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>% <bar>", "--", "--load-icon-pattern", "<icon=bright_%%.xpm/>"] + cpuArgs <- getArguments args + cpuValue <- runCpu cpuArgs + cpuValue `shouldSatisfy` (\item -> not $ "<icon=bright_" `isInfixOf` cpuValue) + it "works with icon pattern template" $ + do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <total>% <bar> <ipat>", "--", "--load-icon-pattern", "<icon=bright_%%.xpm/>"] + cpuArgs <- getArguments args + cpuValue <- runCpu cpuArgs + cpuValue `shouldSatisfy` (\item -> "<icon=bright_" `isInfixOf` cpuValue) + it "works with other parameters in template" $ + do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: <user> <nice> <iowait>"] + cpuArgs <- getArguments args + cpuValue <- runCpu cpuArgs + cpuValue `shouldSatisfy` (\item -> "Cpu:" `isPrefixOf` cpuValue) diff -Nru xmobar-0.33/.travis.yml xmobar-0.36/.travis.yml --- xmobar-0.33/.travis.yml 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/.travis.yml 1970-01-01 01:00:00.000000000 +0100 @@ -1,31 +0,0 @@ -language: haskell - -dist: xenial - -apt: - update: true - sources: - - hvr-ghc - packages: cabal-install-2.2 - -ghc: - - 8.0 - - 8.2 - - 8.4 - - 8.6 - - 8.8 - -before_install: - - sudo apt-get -qq update - - sudo apt-get install -y libiw-dev libasound2-dev libxpm-dev libmpd-dev - - sudo apt-get install -y libxrandr-dev - - sudo apt-get install -y happy c2hs - - export PATH=/opt/ghc/bin:$PATH - -install: - - travis_wait 30 cabal install --only-dependencies --enable-tests -fall_extensions - - wget https://raw.github.com/ndmitchell/hlint/master/misc/travis.sh - -script: -# - sh ./travis.sh src - - cabal configure --enable-tests -fall_extensions && cabal build && cabal test diff -Nru xmobar-0.33/xmobar.cabal xmobar-0.36/xmobar.cabal --- xmobar-0.33/xmobar.cabal 2020-02-26 21:54:56.000000000 +0100 +++ xmobar-0.36/xmobar.cabal 2020-08-22 18:45:20.000000000 +0200 @@ -1,5 +1,5 @@ name: xmobar -version: 0.33 +version: 0.36 homepage: http://xmobar.org synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. @@ -13,7 +13,7 @@ author: Andrea Rossato and Jose A. Ortega Ruiz maintainer: Jose A. Ortega Ruiz <jao@gnu.org> bug-reports: https://github.com/jaor/xmobar/issues -cabal-version: >= 1.8 +cabal-version: >= 1.10 build-type: Simple extra-source-files: readme.md, changelog.md, @@ -92,9 +92,13 @@ default: True library + default-language: Haskell2010 hs-source-dirs: src - exposed-modules: Xmobar + exposed-modules: Xmobar, + Xmobar.Plugins.Monitors.Common.Types, + Xmobar.Plugins.Monitors.Common.Run, + Xmobar.Plugins.Monitors.Cpu other-modules: Paths_xmobar, Xmobar.Config.Types, @@ -129,6 +133,7 @@ Xmobar.Plugins.CommandReader, Xmobar.Plugins.Date, Xmobar.Plugins.EWMH, + Xmobar.Plugins.HandleReader, Xmobar.Plugins.PipeReader, Xmobar.Plugins.MarqueePipeReader, Xmobar.Plugins.StdinReader, @@ -138,14 +143,11 @@ Xmobar.Plugins.Monitors, Xmobar.Plugins.Monitors.Batt, Xmobar.Plugins.Monitors.Common, - Xmobar.Plugins.Monitors.Common.Types, - Xmobar.Plugins.Monitors.Common.Run, Xmobar.Plugins.Monitors.Common.Output, Xmobar.Plugins.Monitors.Common.Parsers, Xmobar.Plugins.Monitors.Common.Files, Xmobar.Plugins.Monitors.CoreTemp, Xmobar.Plugins.Monitors.CpuFreq, - Xmobar.Plugins.Monitors.Cpu, Xmobar.Plugins.Monitors.Disk, Xmobar.Plugins.Monitors.Mem, Xmobar.Plugins.Monitors.MultiCoreTemp, @@ -164,12 +166,12 @@ ghc-options: -funbox-strict-fields -Wall -fno-warn-unused-do-bind build-depends: - base >= 4.9.1.0 && < 4.14, + base >= 4.11.0 && < 4.15, containers, regex-compat, process, old-locale, - bytestring, + bytestring >= 0.10.8.2, directory, unix, time, @@ -210,11 +212,11 @@ if flag(with_inotify) || flag(all_extensions) build-depends: hinotify >= 0.3 && < 0.5 - exposed-modules: Xmobar.Plugins.Mail, Xmobar.Plugins.MBox + other-modules: Xmobar.Plugins.Mail, Xmobar.Plugins.MBox cpp-options: -DINOTIFY if flag(with_iwlib) || flag(with_nl80211) || flag(all_extensions) - exposed-modules: Xmobar.Plugins.Monitors.Wireless + other-modules: Xmobar.Plugins.Monitors.Wireless if flag(with_iwlib) extra-libraries: iw @@ -228,25 +230,25 @@ if flag(with_mpd) || flag(all_extensions) build-depends: libmpd >= 0.9.0.10 - exposed-modules: Xmobar.Plugins.Monitors.MPD + other-modules: Xmobar.Plugins.Monitors.MPD cpp-options: -DLIBMPD if flag(with_alsa) || flag(all_extensions) build-depends: alsa-mixer >= 0.3 && < 0.4 build-depends: alsa-core == 0.5.*, process >= 1.4.3.0 - exposed-modules: Xmobar.Plugins.Monitors.Volume + 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.*, timezone-series == 0.1.* - exposed-modules: Xmobar.Plugins.DateZone + build-depends: timezone-olson >= 0.1 && < 0.3, timezone-series == 0.1.* + other-modules: Xmobar.Plugins.DateZone cpp-options: -DDATEZONE if flag(with_mpris) || flag(all_extensions) build-depends: dbus >= 1 - exposed-modules: Xmobar.Plugins.Monitors.Mpris + other-modules: Xmobar.Plugins.Monitors.Mpris cpp-options: -DMPRIS if flag(with_dbus) || flag(all_extensions) @@ -260,12 +262,12 @@ cpp-options: -DXPM if flag(with_weather) || flag(all_extensions) - exposed-modules: Xmobar.Plugins.Monitors.Weather + other-modules: Xmobar.Plugins.Monitors.Weather cpp-options: -DWEATHER - build-depends: http-conduit, http-types + build-depends: http-conduit, http-types, http-client-tls if flag(with_uvmeter) - exposed-modules: Xmobar.Plugins.Monitors.UVMeter + other-modules: Xmobar.Plugins.Monitors.UVMeter build-depends: http-conduit, http-types cpp-options: -DUVMETER @@ -275,6 +277,7 @@ cpp-options: -DFREEBSD executable xmobar + default-language: Haskell2010 hs-source-dirs: app main-is: Main.hs build-depends: base, @@ -300,6 +303,7 @@ cpp-options: -DTHREADED_RUNTIME test-suite XmobarTest + default-language: Haskell2010 type: exitcode-stdio-1.0 hs-source-dirs: src, test main-is: Spec.hs @@ -327,10 +331,11 @@ other-modules: Xmobar.Plugins.Monitors.CommonSpec Xmobar.Plugins.Monitors.Common Xmobar.Plugins.Monitors.Common.Parsers - Xmobar.Plugins.Monitors.Common.Run Xmobar.Plugins.Monitors.Common.Types Xmobar.Plugins.Monitors.Common.Output Xmobar.Plugins.Monitors.Common.Files + Xmobar.Plugins.Monitors.Cpu + Xmobar.Plugins.Monitors.Common.Run Xmobar.Run.Exec Xmobar.App.Timer Xmobar.System.Signal @@ -342,5 +347,15 @@ other-modules: Xmobar.Plugins.Monitors.Volume Xmobar.Plugins.Monitors.Alsa Xmobar.Plugins.Monitors.AlsaSpec + Xmobar.Plugins.Monitors.CpuSpec cpp-options: -DALSA + +benchmark xmobarbench + type: exitcode-stdio-1.0 + main-is: main.hs + hs-source-dirs: + bench + ghc-options: -O2 + build-depends: base, gauge, xmobar, mtl + default-language: Haskell2010