diff options
44 files changed, 1055 insertions, 381 deletions
diff --git a/.forgejo/workflows/test.yml b/.forgejo/workflows/test.yml new file mode 100644 index 0000000..f67eda7 --- /dev/null +++ b/.forgejo/workflows/test.yml @@ -0,0 +1,32 @@ +on: + pull_request: + types: [opened, synchronize, reopened] + + push: + branches: + - 'master' + +jobs: + actions: + strategy: + matrix: + - version: [9.6, 9.4, 8] + + runs-on: docker + container: + image: haskell:${{ matrix.version }} + + steps: + - name: apt ${{ matrix.version }} + run: | + apt-get update + apt-get install -y xorg-dev libxrandr-dev libpango1.0-dev + apt-get install -y libasound2-dev libxpm-dev libmpd-dev + apt-get install -y hspec-discover hlint + - name: hlint ${{ matrix.version }} + run: hlint ./src + - name: cabal tests ${{ matrix.version }} + run: | + cabal update + cabal test --enable-tests -fall_extensions + cabal test --enable-tests -fall_extensions -f-with_xrender diff --git a/.woodpecker.yml b/.woodpecker.yml deleted file mode 100644 index f8aeae3..0000000 --- a/.woodpecker.yml +++ /dev/null @@ -1,20 +0,0 @@ -matrix: - GHC_VERSION: - - 9.6 - - 9.4 - - 8 - -steps: - test: - image: haskell:${GHC_VERSION} - commands: - - apt-get update - - apt-get install -y xorg-dev libxrandr-dev libpango1.0-dev - - apt-get install -y libasound2-dev libxpm-dev libmpd-dev - - apt-get install -y hspec-discover hlint - - - hlint src - - - cabal update - - cabal test --enable-tests -fall_extensions - - cabal test --enable-tests -fall_extensions -f-with_xrender diff --git a/changelog.md b/changelog.md index f533d85..aeb07e3 100644 --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,39 @@ +## Version 0.51 (unrelease) + +- base dependency relaxed to 4.21 + +## Version 0.50 (June, 2025) + +- New plugins: `PacmanUpdates` (thanks, Alexander) +- `ArchUpdates` deprecated in favor of `PacmanUpdates` + - a deprecation notice will be shown to users of that plugin in the bar in + the zero updates case +- `Accordion`: new constructor to allow short version to have plugins too +- `Swap`: update for FreeBSD 15 +- `MPD` compiled again by default with `all_extensions`. + +## Version 0.49 (April, 2025) + +- New plugins: `ArchUpdates` and `Accordion` (thanks, Enrico Maria) +- New template variable `weatherS` for `WeatherX`. +- New Nix flake (thanks, refaelsh) +- `MPRIS`: Fix for duration reported by Spotify (thanks, Claudio) +- Base dep up to 4.20 (thanks, Alexander) + +## Version 0.48.1 (May, 2024) + +- Removing for now mouse support for `Kbd`, which can be recovered by + interested users using regular actions (see issue #703 for further details). + +## Version 0.48 (April, 2024) + +- The `Kbd` monitor is now clickable (thanks, Enrico Maria) +- Fix zombie processes left by `<action>` tag and low battery action (thanks, + Ulrik) +- Fix plugins such as `Alsa` and `Com` not working when configuration is + recompiled (#657, ditto) +- New `Lock'` monitor with configurable labels (thanks, Enrico Maria) + ## Version 0.47.4 (March, 2024) - Bug fixes (launching processes from self-compiled instances) diff --git a/doc/accordion.gif b/doc/accordion.gif Binary files differnew file mode 100644 index 0000000..c21d2b0 --- /dev/null +++ b/doc/accordion.gif diff --git a/doc/plugins.org b/doc/plugins.org index e408dec..442af34 100644 --- a/doc/plugins.org +++ b/doc/plugins.org @@ -306,7 +306,7 @@ "--", "-O", "<fc=green>On</fc> - ", "-i", "", "-L", "-15", "-H", "-5", "-l", "red", "-m", "blue", "-h", "green", - "-a", "notify-send -u critical 'Battery running out!!'", + "-a", "notify-once \"xmobar\" -u critical 'Battery running out!!'", "-A", "3"] 600 #+end_src @@ -316,7 +316,19 @@ separator affect how =<watts>= is displayed. For this monitor, neither the generic nor the specific options have any effect on =<timeleft>=. We are also telling the monitor to execute the unix command - =notify-send= when the percentage left in the battery reaches 6%. + =notify-once= when the percentage left in the battery reaches 6%. + + =notify-once= is a bash wrapper script provided with the =xmobar= package. + =xmobar= will run the notification command according to the refresh period, + this has the effect of spamming the notification tray if calling =notify-send= directly. + =notify-once= script deduplicates the notification by indicating to =notify-send= + the last notification we want to replace. + See [[https://codeberg.org/xmobar/xmobar/issues/746][#746]] for more information. + Note that your notification daemon should handle notification replacement + for this to work. Whether the replacement resets the timeout is also handled by the + notification daemon. + For example, the =wired-notify= implementation has =replacing_enabled= + and =replacing_resets_timeout= configuration options [[https://github.com/Toqozz/wired-notify/wiki/Config]]. It is also possible to specify template variables in the =-O= and =-o= switches, as in the following example: @@ -658,9 +670,8 @@ ** Keyboard and screen monitors *** =Kbd Opts= - - Registers to XKB/X11-Events, output the currently active keyboard - layout, and maps left and right clicks to switching to next and - previous layouts respectively. Supports replacement of layout names. + - Registers to XKB/X11-Events and output the currently active keyboard + layout. Supports replacement of layout names. - Aliases to =kbd= @@ -698,18 +709,37 @@ #+begin_src haskell Run Brightness ["-t", "<bar>"] 60 #+end_src + *** =Locks= - Displays the status of Caps Lock, Num Lock and Scroll Lock. - Aliases to =locks= + - Contructors: + + - =Locks= is nullary and uses the strings =CAPS=, =NUM=, =SCROLL= to signal + that a lock is enabled (and empty strings to signal it's disabled) + + - =Locks'= allow customizing the strings for the enabled/disabled states + of the 3 locks by accepting an assoc list of type =[(String, (String, String))]=, + which is expected to contain exactly 3 elements with keys + ="CAPS"=, ="NUM"=, ="SCROLL"=. + - Example: #+begin_src haskell + -- using default labels Run Locks #+end_src + #+begin_src haskell + -- using custom labels + Run $ Locks' [("CAPS" , ("<fc=#00ff00>\xf023</fc>", "<fc=#777777>\xf09c</fc>") ) + ,("NUM" , ("<fc=#777777>\xf047</fc>", "<fc=#00ff00>\xf047</fc>" ) ) + ,("SCROLL", ("SlOCK", "" ))] + #+end_src + ** Load and Process monitors *** =Load Args RefreshRate= @@ -1059,8 +1089,8 @@ ** Music monitors *** =MPD Args RefreshRate= - - This monitor will only be compiled if you ask for it using the - =with_mpd= flag. It needs [[http://hackage.haskell.org/package/libmpd/][libmpd]] 5.0 or later (available on Hackage). + - This monitor will only be compiled if you ask for it using the =with_mpd= + flag. It needs [[http://hackage.haskell.org/package/libmpd/][libmpd]] 0.10.1 or later (available on Hackage). - Aliases to =mpd= @@ -1250,9 +1280,11 @@ - Works in the same way as =Weather=, but takes an additional argument, a list of pairs from sky conditions to their replacement (typically a unicode string or an icon specification). - - Use the variable =skyConditionS= to display the replacement of the - corresponding sky condition. All other =Weather= template variables - are available as well. + - Use the variable =skyConditionS= or =weatherS= to display the replacement of + the corresponding sky condition. =weatherS= uses the string returned by + =weather= to look up a replacement, and, if that one is not found, it + looks up the value of =skyConditionS=. All other =Weather= template + variables are available as well. For example: @@ -1303,7 +1335,7 @@ #+begin_src haskell Run UVMeter "Brisbane" ["-H", "3", "-L", "3", "--low", "green", "--high", "red"] 900 #+end_src -** Other monitors +** Other monitors and plugins *** =CatInt n filename= - Reads and displays an integer from the file whose path is =filename= @@ -1333,6 +1365,94 @@ the display of those numeric fields. - Default template: =Up: <days>d <hours>h <minutes>m= +*** =PacmanUpdates (Zero, One, Many, Error) Rate= + + - *This constructor is deprecated. Use =PacmanUpdatesK= or =PacmanUpdatesNoK= instead.* + - Aliases to =pacman= + - =Zero=: a =String= to use when the system is up to date. + - =One=: a =String= to use when only one update is available. + - =Many=: a =String= to use when several updates are available; it can contain + a =?= character as a placeholder for the number of updates. + - =Error=: a =String= to use when pacman fails for unkown reasons (e.g. + network error) + - Example: + #+begin_src haskell + PacmanUpdates ("<fc=green>up to date</fc>", + "<fc=yellow>1 update</fc>, + "<fc=red>? updates</fc>", + "<fc=red>!Pacman Error!</fc>") + 600 + #+end_src + +*** =PacmanUpdatesK Rate KernName (Bool -> Either String (Int, Bool) -> String)= + + - Aliases to =pacman= + - =KernName=: a =String= containing the name of the kernel package, e.g. `linux`, `linux-lts`, … + - =(Bool -> Either String (Int, Bool) -> String)=: a function producing the + string to be shown by the plugin; it is fed with a `Bool` telling whether + the running kernel is older than the installed kernel, and an `Int` and + `Bool` telling the number of available updates and whether one of them is a + kernel update (or an error message if `checkupdates` fails). + - Example: + #+begin_src haskell + PacmanUpdatesK + 600 + "linux" + $ \oldKern mayb -> (if oldKern then "Running old kernel!" else "") ++ + case mayb of + Left _ -> "Some error occurred!" + Right (0, False) -> "Up to date" + Right (n, pendingK) | n >= 1 -> show n ++ " updates available" + ++ if pendingK then " including a kernel update" else "" + _ -> error "This is impossible" + #+end_src + +*** =PacmanUpdatesNoK Rate (Bool -> Either String Int -> String)= + + - Aliases to =pacman= + - =(Bool -> Either String Int -> String)=: a function producing the + string to be shown by the plugin; it is fed with a `Bool` telling whether + the running kernel is older than the installed kernel, and an `Int` telling + the number of available updates (or an error message if `checkupdates` fails). + - Example: + #+begin_src haskell + PacmanUpdatesNoK + 600 + $ \oldKern mayb -> (if oldKern then "Running old kernel!" else "") ++ + case mayb of + Left _ -> "Some error occurred!" + Right 0 -> "" + Right n | n >= 1 -> show n ++ " updates available" + _ -> error "impossible" + #+end_src + +*** =makeAccordion Tuning [Runnable]= + + - Wraps other =Runnable= plugins and makes them all collapsible to a single string: + + [[file:accordion.gif]] + + - Aliases to =alias' tuning=, being =tuning= of type =Tuning=, so one can use multiple such "accordions" + - **Disclaimer**: This only works for Haskell =xmobar.hs= + - =Tuning=: the "settings", for which a default value is provided, + #+begin_src haskell + defaultTuning = Tuning { + alias' = "accordion" + , initial = True + , expand = "<>" + , shrink = "><" + } + #+end_src + - =expand=: =String= shown when the accordion is contracted (defaults to ="<>"=). + - =shrink=: =String= shown when the accordion is expanded (defaults to ="><"=). + - =initial=: =Bool= to tell whether the accordion is initially expanded (defaults to =True=). + - =[Runnable]=: a list of =Runnable= plugins + +*** =makeAccordion' Tuning [Runnable] [Runnable]= + + - Like =makeAccordion=, but it accepts two distinct lists of runnables to be shown in the two states. + - One possible usage is to have a long-vs-short rather than an expanded-vs-collapsed policy, but it's up to you. + * Interfacing with window managers :PROPERTIES: :CUSTOM_ID: interfacing-with-window-managers @@ -1557,8 +1677,6 @@ xmonad configuration (=xmonad.hs=), e.g. by using a custom =~/.xmonad/build= script. - - * Executing external commands In order to execute an external command you can either write the diff --git a/etc/notify-once.sh b/etc/notify-once.sh new file mode 100644 index 0000000..1c46401 --- /dev/null +++ b/etc/notify-once.sh @@ -0,0 +1,31 @@ +#!/usr/bin/env bash + +set -euo pipefail + +help() { + echo "notify-send: send deduplicated notifications" + echo "Usage: notify-once <name> [ARGS]" + echo " ARGS are arguments passed directly to notify-send" +} + +if [ $# -lt 1 ]; then + echo "Should get at least one argument, a name" >&2 + help + exit 1 +fi +APPNAME="$1" +shift + +ID_PATH="/tmp/notify-state-$APPNAME" + +if [ -e "$ID_PATH" ]; then + # Exists, replace + ID=$(cat "$ID_PATH") + ID=$(notify-send -r "$ID" -p "$@") +else + # Doesn't exist, create + ID=$(notify-send -p "$@") +fi + +# Store new ID +echo "$ID" >"$ID_PATH" diff --git a/flake.lock b/flake.lock deleted file mode 100644 index e60d10e..0000000 --- a/flake.lock +++ /dev/null @@ -1,75 +0,0 @@ -{ - "nodes": { - "flake-utils": { - "locked": { - "lastModified": 1653893745, - "narHash": "sha256-0jntwV3Z8//YwuOjzhV2sgJJPt+HY6KhU7VZUL0fKZQ=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "1ed9fb1935d260de5fe1c2f7ee0ebaae17ed2fa1", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "git-ignore-nix": { - "inputs": { - "nixpkgs": "nixpkgs" - }, - "locked": { - "lastModified": 1646480205, - "narHash": "sha256-kekOlTlu45vuK2L9nq8iVN17V3sB0WWPqTTW3a2SQG0=", - "owner": "hercules-ci", - "repo": "gitignore.nix", - "rev": "bff2832ec341cf30acb3a4d3e2e7f1f7b590116a", - "type": "github" - }, - "original": { - "owner": "hercules-ci", - "ref": "master", - "repo": "gitignore.nix", - "type": "github" - } - }, - "nixpkgs": { - "locked": { - "lastModified": 1632846328, - "narHash": "sha256-sFi6YtlGK30TBB9o6CW7LG9mYHkgtKeWbSLAjjrNTX0=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "2b71ddd869ad592510553d09fe89c9709fa26b2b", - "type": "github" - }, - "original": { - "id": "nixpkgs", - "type": "indirect" - } - }, - "nixpkgs_2": { - "locked": { - "lastModified": 1654398695, - "narHash": "sha256-Kw/KeoFXszNsF5mORP45mrxCP+k9Aq03hWcuWCL9sdI=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "c5d810f4c74c824ae0fb788103003c6c9d366a08", - "type": "github" - }, - "original": { - "id": "nixpkgs", - "type": "indirect" - } - }, - "root": { - "inputs": { - "flake-utils": "flake-utils", - "git-ignore-nix": "git-ignore-nix", - "nixpkgs": "nixpkgs_2" - } - } - }, - "root": "root", - "version": 7 -} diff --git a/flake.nix b/flake.nix deleted file mode 100644 index 7471fb9..0000000 --- a/flake.nix +++ /dev/null @@ -1,45 +0,0 @@ -{ - inputs = { - git-ignore-nix.url = "github:hercules-ci/gitignore.nix/master"; - flake-utils.url = "github:numtide/flake-utils"; - }; - outputs = { self, nixpkgs, flake-utils, git-ignore-nix }: - let - overlay = final: prev: { - haskellPackages = prev.haskellPackages.override (old: { - overrides = prev.lib.composeExtensions (old.overrides or (_: _: { })) - (hself: hsuper: { - xmobar = prev.haskell.lib.compose.dontCheck (hself.callCabal2nix "xmobar" - (git-ignore-nix.lib.gitignoreSource ./.) { }); - }); - }); - }; - overlays = [ overlay ]; - in flake-utils.lib.eachDefaultSystem (system: - let pkgs = import nixpkgs { inherit system overlays; }; - dynamicLibraries = with pkgs; [ - xorg.libX11 - xorg.libXrandr - xorg.libXrender - xorg.libXScrnSaver - xorg.libXext - xorg.libXft - xorg.libXpm.out - xorg.libXrandr - xorg.libXrender - ]; - in rec { - devShell = pkgs.haskellPackages.shellFor { - packages = p: [ p.xmobar ]; - buildInputs = with pkgs; [ - haskellPackages.cabal-install - #haskellPackages.haskell-language-server - ] ++ dynamicLibraries; - - LD_LIBRARY_PATH = pkgs.lib.strings.makeLibraryPath dynamicLibraries; - }; - defaultPackage = pkgs.haskellPackages.xmobar; - }) // { - inherit overlay overlays; - }; -} diff --git a/nix/default.nix b/nix/default.nix new file mode 100644 index 0000000..aea52ed --- /dev/null +++ b/nix/default.nix @@ -0,0 +1,130 @@ +{ + config, + lib, + pkgs, + ... +}: +with lib; +let + cfg = config.programs.nixmobar; +in +{ + options.programs.nixmobar = { + enable = mkEnableOption (mdDoc "Xmobar, a minimalistic status bar"); + + font = mkOption { + type = types.str; + default = "Fira Code 13"; + description = mdDoc "Main font for Xmobar."; + }; + + additionalFonts = mkOption { + type = types.listOf types.str; + default = [ "Fira Code 22" ]; + description = mdDoc "Additional fonts for use in Xmobar."; + }; + + bgColor = mkOption { + type = types.str; + default = "#282a36"; + description = mdDoc "Background color of Xmobar."; + }; + + fgColor = mkOption { + type = types.str; + default = "#f8f8f2"; + description = mdDoc "Foreground (text) color of Xmobar."; + }; + + textOffset = mkOption { + type = types.int; + default = 2; + description = mdDoc "Offset of the text from the edge."; + }; + + verbose = mkOption { + type = types.bool; + default = true; + description = mdDoc "Enable verbose mode for Xmobar."; + }; + + allDesktops = mkOption { + type = types.bool; + default = true; + description = mdDoc "Show Xmobar on all desktops."; + }; + + lowerOnStart = mkOption { + type = types.bool; + default = true; + description = mdDoc "Whether Xmobar should be lowered on start."; + }; + + overrideRedirect = mkOption { + type = types.bool; + default = true; + description = mdDoc "If true, Xmobar will bypass window manager redirection."; + }; + + position = mkOption { + type = types.str; + default = "BottomH 26"; + description = mdDoc "Position of Xmobar on the screen."; + }; + + alpha = mkOption { + type = types.int; + default = 200; + description = mdDoc "Transparency level of Xmobar (0-255)."; + }; + + commands = mkOption { + type = types.lines; + default = '' + Run XMonadLog + Run DiskU ["/", "<fc=#bd93f9><fn=1>\\xf0a0</fn></fc> <free>"] [] 50 + Run DiskIO ["/", "<read><fc=#bd93f9> R</fc> <fc=#bd93f9>W</fc> <write>"] ["-t", "", "-w", "4"] 10 + Run Date "%a %_d %b %H:%M:%S" "date" 10 + # Add more commands here, one per line + ''; + description = mdDoc "List of commands to run in Xmobar, each on a new line."; + }; + + alignSep = mkOption { + type = types.str; + default = "}{"; + description = mdDoc "Separators for alignment left and right."; + }; + + template = mkOption { + type = types.str; + default = "<hspace=8/>%XMonadLog% }{ %load%|%disku%|%diskio%|<fc=#bd93f9><fn=1></fn></fc>%wifi_signal%|%dynnetwork%|<fc=#bd93f9><fn=1></fn></fc>%cat0%|%multicoretemp%|%cpufreq%|%multicpu%|<fc=#bd93f9><fn=1></fn></fc>%kbd%|%memory% %swap%|%battery%|%alsa:default:Master%|<fc=#bd93f9><fn=1></fn></fc>%kernel_version%|%date%|%_XMONAD_TRAYPAD%"; + description = mdDoc "Template string for Xmobar layout."; + }; + }; + + config = mkIf cfg.enable { + home.packages = [ pkgs.xmobar ]; + xdg.configFile."xmobar/.xmobarrc" = { + text = # haskell + '' + Config { + font = "${cfg.font}", + additionalFonts = [${lib.concatMapStringsSep ", " (s: "\"" + s + "\"") cfg.additionalFonts}], + bgColor = "${cfg.bgColor}", + fgColor = "${cfg.fgColor}", + textOffset = ${toString cfg.textOffset}, + verbose = ${if cfg.verbose then "True" else "False"}, + allDesktops = ${if cfg.allDesktops then "True" else "False"}, + lowerOnStart = ${if cfg.lowerOnStart then "True" else "False"}, + overrideRedirect = ${if cfg.overrideRedirect then "True" else "False"}, + position = ${cfg.position}, + alpha = ${toString cfg.alpha}, + commands = [${cfg.commands}], + alignSep = "${cfg.alignSep}", + template = "${cfg.template}" + } + ''; + }; + }; +} diff --git a/nix/flake.lock b/nix/flake.lock new file mode 100644 index 0000000..3f272ee --- /dev/null +++ b/nix/flake.lock @@ -0,0 +1,95 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1726560853, + "narHash": "sha256-X6rJYSESBVr3hBoH0WbKE5KvhPU5bloyZ2L4K60/fPQ=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "c1dfcf08411b08f6b8615f7d8971a2bfa81d5e8a", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "git-ignore-nix": { + "inputs": { + "nixpkgs": "nixpkgs" + }, + "locked": { + "lastModified": 1709087332, + "narHash": "sha256-HG2cCnktfHsKV0s4XW83gU3F57gaTljL9KNSuG6bnQs=", + "owner": "hercules-ci", + "repo": "gitignore.nix", + "rev": "637db329424fd7e46cf4185293b9cc8c88c95394", + "type": "github" + }, + "original": { + "owner": "hercules-ci", + "ref": "master", + "repo": "gitignore.nix", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1666603677, + "narHash": "sha256-apAEIj+z1iwMaMJ4tB21r/VTetfGDLDzuhXRHJknIAU=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "074da18a72269cc5a6cf444dce42daea5649b2fe", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "type": "indirect" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1728018373, + "narHash": "sha256-NOiTvBbRLIOe5F6RbHaAh6++BNjsb149fGZd1T4+KBg=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "bc947f541ae55e999ffdb4013441347d83b00feb", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixos-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "git-ignore-nix": "git-ignore-nix", + "nixpkgs": "nixpkgs_2" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/nix/flake.nix b/nix/flake.nix new file mode 100644 index 0000000..b422c9a --- /dev/null +++ b/nix/flake.nix @@ -0,0 +1,64 @@ +{ + inputs = { + nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable"; + git-ignore-nix.url = "github:hercules-ci/gitignore.nix/master"; + flake-utils.url = "github:numtide/flake-utils"; + }; + outputs = + { + self, + nixpkgs, + flake-utils, + git-ignore-nix, + }: + let + overlay = final: prev: { + haskellPackages = prev.haskellPackages.override (old: { + overrides = prev.lib.composeExtensions (old.overrides or (_: _: { })) ( + hself: hsuper: { + xmobar = prev.haskell.lib.compose.dontCheck ( + hself.callCabal2nix "xmobar" (git-ignore-nix.lib.gitignoreSource ./.) { } + ); + } + ); + }); + }; + overlays = [ overlay ]; + + homeModules.mainmodule = import ./default.nix; + in + flake-utils.lib.eachDefaultSystem ( + system: + let + pkgs = import nixpkgs { inherit system overlays; }; + dynamicLibraries = with pkgs; [ + xorg.libX11 + xorg.libXrandr + xorg.libXrender + xorg.libXScrnSaver + xorg.libXext + xorg.libXft + xorg.libXpm.out + xorg.libXrandr + xorg.libXrender + ]; + in + { + devShell = pkgs.haskellPackages.shellFor { + packages = p: [ p.xmobar ]; + buildInputs = + with pkgs; + [ + haskellPackages.cabal-install + ] + ++ dynamicLibraries; + + LD_LIBRARY_PATH = pkgs.lib.strings.makeLibraryPath dynamicLibraries; + }; + defaultPackage = pkgs.haskellPackages.xmobar; + } + ) + // { + inherit overlay overlays homeModules; + }; +} diff --git a/nix/readme.org b/nix/readme.org new file mode 100644 index 0000000..6a492e5 --- /dev/null +++ b/nix/readme.org @@ -0,0 +1,80 @@ +* Nix flake for Xmobar +This flake exposes a module to use with home-manager. +Here is how to set it up: + +1. Add the nixmobar flake as an input to your NiOS flake: + #+BEGIN_SRC nix + inputs = { + nixmobar.url = "git+https://codeberg.org/xmobar/xmobar.git/?dir=nix"; + }; + #+END_SRC + +2. And then, where you import your `home.nix`, add `extraSpecialArgs` like this: + #+BEGIN_SRC nix + home-manager = { + extraSpecialArgs = { + inherit inputs nixmobar; + }; + users.refaelsh = import ./home.nix; + }; + #+END_SRC + +3. Final step, use the module in `home.nix`: + #+BEGIN_SRC nix + { + inputs, + ... + }: + { + home.stateversion = "24.05"; + + imports = [ + inputs.nixmobar.homeModules.mainmodule + # Other imports go here. + ]; + + } + #+END_SRC + +* Example usage +#+BEGIN_SRC haskell +{ + programs.nixmobar = { + enable = true; + font = "Fira Code 13"; + additionalFonts = [ "Fira Code 22" ]; + bgColor = "#282A36"; + fgColor = "#F8F8F2"; + textOffset = 2; + verbose = true; + allDesktops = true; + lowerOnStart = true; + overrideRedirect = true; + position = "BottomH 26"; + alpha = 200; + alignSep = "}{"; + template = "<hspace=8/>%XMonadLog% }{ %load%|%disku%|%diskio%|<fc=#bd93f9><fn=1></fn></fc>%wifi_signal%|%dynnetwork%|<fc=#bd93f9><fn=1></fn></fc>%cat0%|%multicoretemp%|%cpufreq%|%multicpu%|<fc=#bd93f9><fn=1></fn></fc>%kbd%|%memory% %swap%|%battery%|%alsa:default:Master%|<fc=#bd93f9><fn=1></fn></fc>%kernel_version%|%date%|%_XMONAD_TRAYPAD%"; + commands = # haskell + '' + Run XMonadLog, + Run DiskU [("/", "<fc=#bd93f9><fn=1>\xf0a0</fn></fc> <free>")] [] 50, + Run DiskIO [("/", "<read><fc=#bd93f9> R</fc> <fc=#bd93f9>W</fc> <write>")] ["-t", "", "-w", "4"] 10, + Run DynNetwork ["-t", "<rx>KB/s<fc=#bd93f9><fn=1>\x1F89B</fn></fc><fc=#bd93f9><fn=1>\x1F899</fn></fc><tx>KB/s", "-w", "5"] 10, + Run Memory ["-t", "<fc=#bd93f9><fn=1>\xE266</fn></fc><usedratio>%"] 10, + Run Swap ["-t", "<fc=#bd93f9>S</fc><usedratio>%"] 10, + Run Kbd [], + Run CpuFreq ["-t", "<avg>GHz"] 50, + Run MultiCoreTemp ["-t", "<fc=#bd93f9><fn=1>\xf2c9</fn></fc><avg>°", "-L", "60", "-H", "95", "-l", "white", "-n", "white", "-h", "red"] 50, + Run CatInt 0 "/sys/class/hwmon/hwmon4/fan1_input" [] 50, + Run MultiCpu ["-t", "<fc=#bd93f9><fn=1>\xf4bc</fn></fc> <vbar0><vbar1><vbar2><vbar3><vbar4><vbar5><vbar6><vbar7>", "-w", "99", "-L", "3", "-H", "50", "--normal", "green", "--high", "red"] 10, + Run BatteryP ["BAT0"] ["-t", "<fc=#bd93f9><fn=1></fn></fc><left>%", "-L", "10", "-H", "80", "-p", "3", "--", "-O", "<fc=green>On</fc> - ", "-i", "", "-L", "-15", "-H", "-5", "-l", "red", "-m", "blue", "-h", "green", "-a", "notify-once \"xmobar\" -u critical 'Battery running out!!'", "-A", "3"] 600, + Run Alsa "default" "Master" ["-t", "<fc=#bd93f9><fn=1>\xf028</fn></fc> <volume>%"], + Run Date "%a %_d %b %H:%M:%S" "date" 10, + Run Load ["-t", "<fc=#bd93f9><fn=0>L</fn></fc><load1>", "-L", "1", "-H", "3", "-d", "2"] 300, + Run ComX "nmcli" ["-t", "-f", "SIGNAL", "dev", "wifi"] "N/A" "wifi_signal" 50, + Run Com "uname" ["-r"] "kernel_version" 3600, + Run XPropertyLog "_XMONAD_TRAYPAD" + ''; + }; +} +#+END_SRC @@ -5,9 +5,6 @@ <a href="http://hackage.haskell.org/package/xmobar"> <img src="https://img.shields.io/hackage/v/xmobar.svg" alt="hackage"/> </a> - <a href="https://ci.codeberg.org/xmobar/xmobar"> - <img src="https://ci.codeberg.org/api/badges/xmobar/xmobar/status.svg" alt="ci"/> - </a> </p> #+end_export @@ -31,13 +28,6 @@ channel, ~#xmobar~, at [[ircs://irc.libera.chat][Libera]]. * Breaking news - - Starting with version 0.47.1, we are excluding MPD from the extensions - included with ~all_extensions~ when GHC version is 9.4 or greater, because - that seems to break cabal compilation. However, it's been reported that - in some installations compilation with ~libmpd~ works fine: just add - explicitly the ~with_mpd~ flag to include MPD and check for yourself. - Compilation with stack has also been reported to work. Please see the - comments in issue #679 for details. - Starting with version 0.45, we use cairo/pango as our drawing engine (instead of plain X11/Xft). From a user's point of view, that change should be mostly transparent, except for the facts that it's allowed @@ -173,24 +163,24 @@ channel, ~#xmobar~, at [[ircs://irc.libera.chat][Libera]]. the greater xmobar and Haskell communities. In particular, xmobar incorporates patches by Kostas Agnantis, Mohammed - Alshiekh, Alex Ameen, Axel Angel, Dhananjay Balan, Claudio Bley, Dragos - Boca, Ben Boeckel, Ivan Brennan, Duncan Burke, Roman Cheplyaka, Patrick - Chilton, Antoine Eiche, Nathaniel Wesley Filardo, Guy Gastineau, John - Goerzen, Jonathan Grochowski, Patrick Günther, Reto Hablützel, Corey Halpin, - Juraj Hercek, Jaroslaw Jantura, Tomáš Janoušek, Ada Joule, Spencer Janssen, - Roman Joost, Pavel Kalugin, Jochen Keil, Sam Kirby, Lennart Kolmodin, - Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, Vanessa McHale, - Robert J. Macomber, Dmitry Malikov, David McLean, Joan Milev, Marcin - Mikołajczyk, Dino Morelli, Tony Morris, Eric Mrak, Thiago Negri, Edward - O'Callaghan, Svein Ove, Martin Perner, Jens Petersen, Alexander Polakov, - Sibi Prabakaran, Pavan Rikhi, Petr Rockai, Andrew Emmanuel Rosa, - Sackville-West, Amir Saeid, Markus Scherer, Daniel Schüssler, Olivier - Schneider, Alexander Shabalin, Valentin Shirokov, Peter Simons, Alexander - Solovyov, Will Song, John Soo, John Soros, Felix Springer, Travis Staton, - Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei Trofimovich, - Thomas Tuegel, John Tyree, Jan Vornberger, Anton Vorontsov, Daniel Wagner, - Zev Weiss, Phil Xiaojun Hu, Nikolay Yakimov, Edward Z. Yang, Leo Zhang, - Norbert Zeh, and Michał Zielonka. + Alshiekh, Alex Ameen, Axel Angel, Enrico Maria De Angelis, Dhananjay Balan, + Claudio Bley, Dragos Boca, Ben Boeckel, Ivan Brennan, Duncan Burke, Roman + Cheplyaka, Patrick Chilton, Antoine Eiche, Nathaniel Wesley Filardo, Guy + Gastineau, John Goerzen, Jonathan Grochowski, Patrick Günther, Reto + Hablützel, Corey Halpin, Juraj Hercek, Jaroslaw Jantura, Tomáš Janoušek, Ada + Joule, Spencer Janssen, Roman Joost, Pavel Kalugin, Jochen Keil, Sam Kirby, + Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, + Vanessa McHale, Robert J. Macomber, Dmitry Malikov, David McLean, Ulrik de + Muelenaere, Joan Milev, Marcin Mikołajczyk, Dino Morelli, Tony Morris, Eric + Mrak, Thiago Negri, Edward O'Callaghan, Svein Ove, Martin Perner, Alexander + Pankoff, Jens Petersen, Alexander Polakov, Sibi Prabakaran, Pavan Rikhi, + Petr Rockai, Andrew Emmanuel Rosa, Sackville-West, Amir Saeid, Markus + Scherer, Daniel Schüssler, Olivier Schneider, Alexander Shabalin, Valentin + Shirokov, Peter Simons, Alexander Solovyov, Will Song, John Soo, John Soros, + Felix Springer, Travis Staton, Artem Tarasov, Samuli Thomasson, Edward + Tjörnhammar, Sergei Trofimovich, Thomas Tuegel, John Tyree, Jan Vornberger, + Anton Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Nikolay Yakimov, + Edward Z. Yang, Leo Zhang, Norbert Zeh, and Michał Zielonka. Andrea wants to thank Robert Manea and Spencer Janssen for their help in understanding how X works. They gave him suggestions on how to solve many @@ -203,6 +193,6 @@ channel, ~#xmobar~, at [[ircs://irc.libera.chat][Libera]]. This software is released under a BSD-style license. See [[https://codeberg.org/xmobar/xmobar/src/branch/master/license][license]] for more details. - Copyright © 2010-2024 Jose Antonio Ortega Ruiz + Copyright © 2010-2025 Jose Antonio Ortega Ruiz Copyright © 2007-2010 Andrea Rossato diff --git a/src/Xmobar.hs b/src/Xmobar.hs index ced40a5..5a31d80 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar --- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017, 2018, 2019, 2022 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2011-2015, 2017-2019, 2022, 2025 Jose Antonio Ortega Ruiz -- (c) 2007 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -19,13 +19,13 @@ module Xmobar (xmobar , xmobarMain , defaultConfig , configFromArgs - , tenthSeconds , Runnable (..) - , Exec (..) , Command (..) , SignalType (..) + , module Xmobar.Run.Exec , module Xmobar.Config.Types , module Xmobar.Config.Parse + , module Xmobar.Plugins.Accordion , module Xmobar.Plugins.BufferedPipeReader , module Xmobar.Plugins.CommandReader , module Xmobar.Plugins.Date @@ -43,6 +43,7 @@ module Xmobar (xmobar #endif , module Xmobar.Plugins.NotmuchMail , module Xmobar.Plugins.Monitors + , module Xmobar.Plugins.PacmanUpdates , module Xmobar.Plugins.PipeReader , module Xmobar.Plugins.MarqueePipeReader , module Xmobar.Plugins.StdinReader @@ -53,6 +54,7 @@ import Xmobar.Run.Runnable import Xmobar.Run.Exec import Xmobar.Config.Types import Xmobar.Config.Parse +import Xmobar.Plugins.Accordion import Xmobar.Plugins.Command import Xmobar.Plugins.BufferedPipeReader import Xmobar.Plugins.CommandReader @@ -70,6 +72,7 @@ import Xmobar.Plugins.Mail import Xmobar.Plugins.MBox #endif import Xmobar.Plugins.Monitors +import Xmobar.Plugins.PacmanUpdates import Xmobar.Plugins.PipeReader import Xmobar.Plugins.StdinReader import Xmobar.Plugins.MarqueePipeReader diff --git a/src/Xmobar/App/Compile.hs b/src/Xmobar/App/Compile.hs index 368c3e6..e5b08b7 100644 --- a/src/Xmobar/App/Compile.hs +++ b/src/Xmobar/App/Compile.hs @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Compile --- Copyright: (c) 2018 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2026 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -20,20 +20,17 @@ module Xmobar.App.Compile(recompile, trace, xmessage) where import Control.Monad.IO.Class -import Control.Monad.Fix (fix) -import Control.Exception.Extensible (try, bracket, SomeException(..)) -import qualified Control.Exception.Extensible as E +import Control.Exception (SomeException(..)) +import qualified Control.Exception as E import Control.Monad (filterM, when) import Data.List ((\\)) -import Data.Maybe (isJust) import System.FilePath((</>), takeExtension) import System.IO import System.Directory import System.Process import System.Exit -import System.Posix.Process(executeFile, forkProcess, getAnyProcessStatus) +import System.Posix.Process(executeFile, forkProcess) import System.Posix.Types(ProcessID) -import System.Posix.Signals isExecutable :: FilePath -> IO Bool isExecutable f = @@ -144,14 +141,12 @@ recompile confDir dataDir execName force verb = liftIO $ do else shouldRecompile verb src bin lib if sc then do - uninstallSignalHandlers - status <- bracket (openFile err WriteMode) hClose $ + status <- withFile err WriteMode $ \errHandle -> waitForProcess =<< if useScript then runScript script bin confDir errHandle else runGHC bin confDir errHandle - installSignalHandlers if status == ExitSuccess then trace verb "Xmobar recompilation process exited with success!" else do @@ -174,21 +169,3 @@ recompile confDir dataDir execName force verb = liftIO $ do ++ ["-o", bin] runGHC bin = runProc "ghc" (opts bin) runScript script bin = runProc script [bin] - --- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to --- avoid zombie processes, and clean up any extant zombie processes. -installSignalHandlers :: MonadIO m => m () -installSignalHandlers = liftIO $ do - installHandler openEndedPipe Ignore Nothing - installHandler sigCHLD Ignore Nothing - (try :: IO a -> IO (Either SomeException a)) - $ fix $ \more -> do - x <- getAnyProcessStatus False False - when (isJust x) more - return () - -uninstallSignalHandlers :: MonadIO m => m () -uninstallSignalHandlers = liftIO $ do - installHandler openEndedPipe Default Nothing - installHandler sigCHLD Default Nothing - return () diff --git a/src/Xmobar/App/Opts.hs b/src/Xmobar/App/Opts.hs index 36da745..e148898 100644 --- a/src/Xmobar/App/Opts.hs +++ b/src/Xmobar/App/Opts.hs @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.Opts --- Copyright: (c) 2018, 2019, 2020, 2022, 2023, 2024 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022, 2023-2026 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -61,7 +61,7 @@ options = , Option "v" ["verbose"] (NoArg Verbose) "Emit verbose debugging messages" , Option "r" ["recompile"] (NoArg Recompile) "Force recompilation" , Option "V" ["version"] (NoArg Version) "Show version information" - , Option "T" ["text"] (OptArg TextOutput "color") + , Option "T" ["text"] (OptArg TextOutput "format") "Write text-only output to stdout. Plain/Ansi/Pango/Swaybar" , Option "f" ["font"] (ReqArg Font "font name") "Font name" , Option "N" ["add-font"] (ReqArg AddFont "font name") @@ -116,7 +116,7 @@ usage = usageInfo header options ++ footer info :: String info = "xmobar " ++ showVersion version - ++ "\n (C) 2010 - 2024 Jose A Ortega Ruiz" + ++ "\n (C) 2010 - 2025 Jose A Ortega Ruiz" ++ "\n (C) 2007 - 2010 Andrea Rossato\n " ++ mail ++ "\n" ++ license ++ "\n" diff --git a/src/Xmobar/Draw/Boxes.hs b/src/Xmobar/Draw/Boxes.hs index 692e232..ff55ab3 100644 --- a/src/Xmobar/Draw/Boxes.hs +++ b/src/Xmobar/Draw/Boxes.hs @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Boxes --- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2022, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -43,11 +43,10 @@ boxLines (T.Box bd offset lw _ margins) ht x0 x1 = T.C -> (ma, -ma) T.R -> (ma, 0) lc = fromIntegral lw / 2 - [mt, mr, mb, ml] = map fromIntegral [top, right, bot, left] - xmin = x0 - ml - lc - xmax = x1 + mr + lc - ymin = mt + lc - ymax = ht - mb - lc + xmin = x0 - fromIntegral left - lc + xmax = x1 + fromIntegral right + lc + ymin = fromIntegral top + lc + ymax = ht - fromIntegral bot - lc rtop = (xmin + p0, ymin, xmax + p1, ymin) rbot = (xmin + p0, ymax, xmax + p1, ymax) rleft = (xmin, ymin + p0, xmin, ymax + p1) diff --git a/src/Xmobar/Draw/Cairo.hs b/src/Xmobar/Draw/Cairo.hs index 8dcda5d..2338b10 100644 --- a/src/Xmobar/Draw/Cairo.hs +++ b/src/Xmobar/Draw/Cairo.hs @@ -2,7 +2,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.X11.Cairo --- Copyright: (c) 2022, 2023 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2022, 2023, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -169,21 +169,22 @@ drawCairoBackground dctx surf = do drawSegments :: T.DrawContext -> Surface -> IO T.Actions drawSegments dctx surf = do - let [left, center, right] = take 3 $ T.dcSegments dctx ++ repeat [] + let segs = take 3 $ T.dcSegments dctx ++ repeat [] dh = T.dcHeight dctx dw = T.dcWidth dctx conf = T.dcConfig dctx sWidth = foldl (\a (_,_,w) -> a + w) 0 ctx <- Pango.cairoCreateContext Nothing Pango.cairoContextSetResolution ctx $ C.dpi conf - llyts <- mapM (withRenderinfo ctx dctx) left - rlyts <- mapM (withRenderinfo ctx dctx) right - clyts <- mapM (withRenderinfo ctx dctx) center + llyts <- mapM (withRenderinfo ctx dctx) (head segs) + rlyts <- mapM (withRenderinfo ctx dctx) (segs !! 2) + clyts <- mapM (withRenderinfo ctx dctx) (segs !! 1) #ifndef XRENDER drawCairoBackground dctx surf #endif (lend, as, bx) <- foldM (drawSegment dctx surf dw) (0, [], []) llyts - let [rw, cw] = map sWidth [rlyts, clyts] + let rw = sWidth rlyts + cw = sWidth clyts rstart = max lend (dw - rw) cstart = if lend > 1 || rw == 0 then max lend ((dw - cw) / 2.0) else lend (_, as', bx') <- if cw > 0 diff --git a/src/Xmobar/Plugins/Accordion.hs b/src/Xmobar/Plugins/Accordion.hs new file mode 100644 index 0000000..ce15cee --- /dev/null +++ b/src/Xmobar/Plugins/Accordion.hs @@ -0,0 +1,112 @@ +{-# LANGUAGE TupleSections, FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} + +----------------------------------------------------------------------------- +-- | +-- Module : Plugins.Monitors.Accordion +-- Copyright : (c) 2024 Enrico Maria De Angelis +-- License : BSD-style (see LICENSE) +-- +-- Maintainer : Enrico Maria De Angelis <enricomaria.dean6elis@gmail.com> +-- Stability : unstable +-- Portability : unportable +-- +-- A plugin to group adjacent plugins and make them, as a whole, shrinkable to +-- an alternate text upon clicking. +-- +----------------------------------------------------------------------------- + +module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, makeAccordion', Tuning(..)) where + +import Control.Concurrent.Async (concurrently_, mapConcurrently_) +import Control.Exception (finally) +import Control.Monad.Extra (whenM) +import Control.Monad (forever, join) +import Control.Monad.IO.Class (liftIO, MonadIO) +import Control.Monad.Reader (MonadReader, runReaderT, ask) +import Control.Monad.State.Strict (MonadState, evalStateT, get, modify') +import Data.IORef (atomicModifyIORef', newIORef, readIORef, IORef) +import GHC.IO.Handle.FD (withFileBlocking) +import System.Directory (removeFile) +import System.IO (IOMode(ReadMode), hGetContents') +import System.Process (readProcessWithExitCode) +import Xmobar.Run.Exec (Exec(..), tenthSeconds) + +-- TODO: Ideally, I'd have just `Accordion`, and not `Tuning`, but since +-- `Accordion` is polymorphic, I can't have a `defaultAccordion` constructor +-- with `plugins = []`, because that leaves `a` undetermined. +-- So I have move all non-polymorphic typed members in `Tuning`, allowing for +-- default values at least for those members. +data Accordion a = Accordion { + tuning :: Tuning + , plugins :: [a] + , shortPlugins :: [a] +} deriving (Show, Read) + +makeAccordion :: Exec a => Tuning -> [a] -> Accordion a +makeAccordion t rs = Accordion { tuning = t, plugins = rs, shortPlugins = [] } + +makeAccordion' :: Exec a => Tuning -> [a] -> [a] -> Accordion a +makeAccordion' t rs rs' = Accordion { tuning = t, plugins = rs, shortPlugins = rs' } + +data Tuning = Tuning { + alias' :: String + , initial :: Bool + , expand :: String + , shrink :: String +} deriving (Read, Show) + +defaultTuning :: Tuning +defaultTuning = Tuning { + alias' = "accordion" + , initial = True + , expand = "<>" + , shrink = "><" +} + +instance Exec a => Exec (Accordion a) where + alias (Accordion Tuning{..} _ _) = alias' + start (Accordion Tuning{..} runnables shortRunnables) cb = do + clicked <- newIORef False + (_, n, _) <- readProcessWithExitCode "uuidgen" [] "" + let pipe = "/tmp/accordion-" ++ removeLinebreak n + (_, _, _) <- readProcessWithExitCode "mkfifo" [pipe] "" + concurrently_ (forever $ do "" <- withFileBlocking pipe ReadMode hGetContents' + atomicModifyIORef' clicked (const (True, ()))) + (do + strRefs <- mapM (newIORef . const "") runnables + strRefs' <- mapM (newIORef . const "") shortRunnables + let processClick = forever (do liftIO (tenthSeconds 1) + whenM (liftIO $ readIORef clicked) + (do liftIO $ clear clicked + modify' not) + get >>= loop pipe) + `runReaderT` (strRefs, strRefs') + `evalStateT` initial + let startRunnables = zipWith start + (runnables ++ shortRunnables) + (map writeToRef $ strRefs ++ strRefs') + parallel_ $ processClick:startRunnables) + `finally` removeFile pipe + where + loop :: (MonadIO m, + MonadState Bool m, + MonadReader ([IORef String], [IORef String]) m) + => String -> Bool -> m () + loop pipe bool = do + (strRefs, strRefs') <- ask + text <- join <$> mapM (liftIO . readIORef) (if bool then strRefs else strRefs') + liftIO $ cb $ text ++ attachClick pipe (if bool then shrink else expand) + parallel_ = mapConcurrently_ id + +writeToRef :: IORef a -> a -> IO () +writeToRef strRef = atomicModifyIORef' strRef . const . (,()) + +clear :: IORef Bool -> IO () +clear = (`atomicModifyIORef'` const (False, ())) + +removeLinebreak :: [a] -> [a] +removeLinebreak = init + +attachClick :: String -> String -> String +attachClick file icon = "<action=`echo -n > " ++ file ++ "`>" ++ icon ++ "</action>" diff --git a/src/Xmobar/Plugins/EWMH.hs b/src/Xmobar/Plugins/EWMH.hs index 78f1cc0..9b583ea 100644 --- a/src/Xmobar/Plugins/EWMH.hs +++ b/src/Xmobar/Plugins/EWMH.hs @@ -232,7 +232,7 @@ updateClientList _ = do where unmanage w = asks display >>= \d -> liftIO $ selectInput d w 0 listen w = asks display >>= \d -> liftIO $ selectInput d w propertyChangeMask - update w = mapM_ (($ w) . snd) clientHandlers + update w = mapM_ (`snd` w) clientHandlers modifyClient :: Window -> (Client -> Client) -> M () modifyClient w f = modify (\s -> s { clients = Map.alter f' w $ clients s }) diff --git a/src/Xmobar/Plugins/Kbd.hs b/src/Xmobar/Plugins/Kbd.hs index 3871ca8..2214628 100644 --- a/src/Xmobar/Plugins/Kbd.hs +++ b/src/Xmobar/Plugins/Kbd.hs @@ -14,11 +14,9 @@ module Xmobar.Plugins.Kbd(Kbd(..)) where -import Data.Bifunctor (bimap) -import Data.List (find, tails, isPrefixOf) +import Data.List (isPrefixOf) import Data.Maybe (fromMaybe) -import Data.Char (toLower, isLetter) -import Data.Function ((&)) +import Data.Char (toLower) import Control.Monad (forever) import Control.Applicative ((<|>)) import Graphics.X11.Xlib @@ -28,13 +26,6 @@ import Xmobar.Run.Exec import Xmobar.X11.Events (nextEvent') import Xmobar.System.Kbd --- some strong typing -newtype Lay = Lay String deriving (Eq) -newtype Sym = Sym String -instance Show Sym where show (Sym s) = s -type KbdOpts' = [(Lay, Sym)] -typed :: [(String, String)] -> [(Lay, Sym)] -typed = map (bimap Lay Sym) -- 'Bad' prefixes of layouts noLaySymbols :: [String] @@ -58,22 +49,15 @@ split p s = case break p s of (pref, "") -> [pref] -- replaces input string if on search list (exact match) with corresponding --- element on replacement list, and returns it paired with the following item +-- element on replacement list. -- --- if not found, return string unchanged, paired with empty string -searchReplaceLayout :: KbdOpts' -> String -> (Lay, Lay, Sym) -searchReplaceLayout opts curr - = maybe (Lay "", Lay "", Sym curr) - pickSymWithAdjLays - (find currLayout (tails $ cycle opts)) - where - pickSymWithAdjLays ((l1, _):(_, s):(l2, _):_) = (l1, l2, s) - pickSymWithAdjLays _ = error "This should never happen" - currLayout = (Lay curr ==) . (!! 1) . map fst - --- returns the active layout and the following one -getCurAndNextKbdLays :: Display -> KbdOpts' -> IO (Lay, Lay, Sym) -getCurAndNextKbdLays dpy opts = do +-- if not found, return string unchanged +searchReplaceLayout :: KbdOpts -> String -> String +searchReplaceLayout opts s = fromMaybe s $ lookup s opts + +-- returns the active layout +getKbdLay :: Display -> KbdOpts -> IO String +getKbdLay dpy opts = do lay <- splitLayout <$> getLayoutStr dpy grps <- map (map toLower . take 2) <$> getGrpNames dpy curLay <- getKbdLayout dpy @@ -89,37 +73,6 @@ getCurAndNextKbdLays dpy opts = do newtype Kbd = Kbd [(String, String)] deriving (Read, Show) -attachClickAction :: (Lay, Lay, Sym) -> Sym -attachClickAction (Lay prv, Lay nxt, txt) = txt & linkTo nxt `onKey` "1" - & linkTo prv `onKey` "3" - where - splitLayParensPhon :: String -> (String, String, String) - splitLayParensPhon = (\(a, (b, c)) -> (a, b, c)) - . second (second (drop 1) . break (== ')') . drop 1) - . break (== '(') - parseLayPhon :: String -> (Maybe String, Maybe String) - parseLayPhon s = let (l, p, i) = splitLayParensPhon s - l' = if all isLetter l - then Just ("-layout " ++ l) - else Nothing - p' = if (p, i) == ("phonetic", "") - then Just "-variant phonetic" - else Nothing - in (l', p') - linkTo :: String -> String -> Sym -> Sym - linkTo linked button currLay = Sym $ case parseLayPhon linked of - (Nothing, _) -> "??" - (Just linkedLay, phon) -> wrapIn setxkbmap button currLay - where - setxkbmap = unwords ["setxkbmap", linkedLay, fromMaybe "" phon] - wrapIn :: String -> String -> Sym -> String - wrapIn action buttons (Sym sym) = openingTag ++ sym ++ closingTag - where - openingTag = "<action=`" ++ action ++ "` button=" ++ buttons ++ ">" - closingTag = "</action>" - onKey = ($) - second = fmap - instance Exec Kbd where alias (Kbd _) = "kbd" start (Kbd opts) cb = do @@ -127,7 +80,7 @@ instance Exec Kbd where dpy <- openDisplay "" -- initial set of layout - cb . show . attachClickAction =<< getCurAndNextKbdLays dpy (typed opts) + cb =<< getKbdLay dpy opts -- enable listing for -- group changes @@ -138,6 +91,7 @@ instance Exec Kbd where allocaXEvent $ \e -> forever $ do nextEvent' dpy e _ <- getEvent e - cb . show . attachClickAction =<< getCurAndNextKbdLays dpy (typed opts) + cb =<< getKbdLay dpy opts closeDisplay dpy + return () diff --git a/src/Xmobar/Plugins/Locks.hs b/src/Xmobar/Plugins/Locks.hs index 9176312..35a3f97 100644 --- a/src/Xmobar/Plugins/Locks.hs +++ b/src/Xmobar/Plugins/Locks.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TupleSections #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Locks @@ -16,45 +17,70 @@ module Xmobar.Plugins.Locks(Locks(..)) where import Graphics.X11 import Data.List +import Data.List.Extra (trim) import Data.Bits +import Data.Maybe (fromJust) import Control.Monad +import Control.Monad.Extra (ifM) import Graphics.X11.Xlib.Extras import Xmobar.Run.Exec import Xmobar.System.Kbd import Xmobar.X11.Events (nextEvent') -data Locks = Locks +data Locks = Locks | Locks' [(String, (String, String))] deriving (Read, Show) locks :: [ ( KeySym, String )] -locks = [ ( xK_Caps_Lock, "CAPS" ) - , ( xK_Num_Lock, "NUM" ) +locks = [ ( xK_Caps_Lock, "CAPS" ) + , ( xK_Num_Lock, "NUM" ) , ( xK_Scroll_Lock, "SCROLL" ) ] -run' :: Display -> Window -> IO String -run' d root = do +type Labels = [ ( String, (String, String) )] +defaultLabels :: Labels +defaultLabels = let nms = map snd locks + in zip nms (map (, mempty) nms) + +type LabelledLock = (KeySym, String, String, String) + +attach :: (KeySym, String) -> Labels -> LabelledLock +(key, lock) `attach` lbls = let (enb, dis) = fromJust $ lookup lock lbls + in (key, lock, enb, dis) + +enabled :: (a, b, c, d) -> c +enabled (_, _, c, _) = c +disabled :: (a, b, c, d) -> d +disabled (_, _, _, d) = d + +isEnabled :: (Bits a1, Foldable t, Foldable t1, Integral a) + => Display -> t (a, t1 KeyCode) -> a1 -> (KeySym, b, c, d) -> IO Bool +isEnabled d modMap m ( ks, _, _, _ ) = do + kc <- keysymToKeycode d ks + return $ case find (elem kc . snd) modMap of + Nothing -> False + Just ( i, _ ) -> testBit m (fromIntegral i) + +run' :: Display -> Window -> Labels -> IO String +run' d root labels = do modMap <- getModifierMapping d ( _, _, _, _, _, _, _, m ) <- queryPointer d root - ls <- filterM ( \( ks, _ ) -> do - kc <- keysymToKeycode d ks - return $ case find (elem kc . snd) modMap of - Nothing -> False - Just ( i, _ ) -> testBit m (fromIntegral i) - ) locks - - return $ unwords $ map snd ls + ls' <- forM (map (`attach` labels) locks) + (\l -> ifM (isEnabled d modMap m l) + (return (enabled l)) + (return (disabled l))) + return $ trim $ unwords ls' instance Exec Locks where - alias Locks = "locks" - start Locks cb = do + alias _ = "locks" + start Locks cb = start (Locks' defaultLabels) cb + start (Locks' labels) cb = do d <- openDisplay "" root <- rootWindow d (defaultScreen d) _ <- xkbSelectEventDetails d xkbUseCoreKbd xkbIndicatorStateNotify m m allocaXEvent $ \ep -> forever $ do - cb =<< run' d root + cb =<< run' d root labels nextEvent' d ep getEvent ep diff --git a/src/Xmobar/Plugins/MarqueePipeReader.hs b/src/Xmobar/Plugins/MarqueePipeReader.hs index 075503c..a6d590e 100644 --- a/src/Xmobar/Plugins/MarqueePipeReader.hs +++ b/src/Xmobar/Plugins/MarqueePipeReader.hs @@ -60,7 +60,7 @@ writer txt sep len rate chan cb = do Nothing -> tenthSeconds rate >> writer (drop 1 txt) sep len rate chan cb toInfTxt :: String -> String -> String -toInfTxt line sep = concat (repeat $ line ++ " " ++ sep ++ " ") +toInfTxt line sep = cycle (line ++ " " ++ sep ++ " ") checkPipe :: FilePath -> IO () checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do diff --git a/src/Xmobar/Plugins/Monitors/Alsa.hs b/src/Xmobar/Plugins/Monitors/Alsa.hs index dfc7329..8d02931 100644 --- a/src/Xmobar/Plugins/Monitors/Alsa.hs +++ b/src/Xmobar/Plugins/Monitors/Alsa.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Alsa --- Copyright : (c) 2018 Daniel Schüssler +-- Copyright : (c) 2018, 2024 Daniel Schüssler -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A. Ortega Ruiz <jao@gnu.org> @@ -25,6 +25,7 @@ import Control.Concurrent.Async import Control.Exception import Control.Monad import Data.IORef +import Data.Maybe (fromJust) import Data.Time.Clock import Xmobar.Plugins.Monitors.Common import qualified Xmobar.Plugins.Monitors.Volume as Volume; @@ -129,7 +130,8 @@ alsaReaderThread mixerName alsaCtlPath outputCallback mvar = {std_out = CreatePipe} runAlsaOnce = - withCreateProcess createProc $ \_ (Just alsaOut) _ _ -> do + withCreateProcess createProc $ \_ out _ _ -> do + let alsaOut = fromJust out hSetBuffering alsaOut LineBuffering tryPutMVar mvar () -- Refresh immediately after restarting alsactl diff --git a/src/Xmobar/Plugins/Monitors/Batt/Common.hs b/src/Xmobar/Plugins/Monitors/Batt/Common.hs index a07ba8b..ddb2b8c 100644 --- a/src/Xmobar/Plugins/Monitors/Batt/Common.hs +++ b/src/Xmobar/Plugins/Monitors/Batt/Common.hs @@ -18,7 +18,7 @@ module Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..) , Status(..) , maybeAlert) where -import System.Process (spawnCommand) +import System.Process (spawnCommand, waitForProcess) import Control.Monad (unless, void) import Xmobar.Plugins.Monitors.Common @@ -54,4 +54,4 @@ maybeAlert opts left = case onLowAction opts of Nothing -> return () Just x -> unless (isNaN left || actionThreshold opts < 100 * left) - $ void $ spawnCommand x + $ void $ spawnCommand (x ++ " &") >>= waitForProcess diff --git a/src/Xmobar/Plugins/Monitors/Common/Output.hs b/src/Xmobar/Plugins/Monitors/Common/Output.hs index 2d0e194..c0a00ab 100644 --- a/src/Xmobar/Plugins/Monitors/Common/Output.hs +++ b/src/Xmobar/Plugins/Monitors/Common/Output.hs @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Plugins.Monitors.Strings --- Copyright: (c) 2018, 2019, 2020, 2022 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -88,9 +88,9 @@ pShowWithColors p f x = do 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 ] ++ + cols = map fromIntegral $ sort [pLow p, pHigh p] -- consider high < low + pure $ head $ [col pHighColor | x > (cols !! 1) ] ++ + [col pNormalColor | x > head cols ] ++ [col pLowColor | True] pSetColor :: MonitorConfig -> String -> PSelector (Maybe String) -> String @@ -197,9 +197,9 @@ colorizeString x s = do h <- getConfigValue high l <- getConfigValue low let col = setColor s - [ll,hh] = map fromIntegral $ sort [l, h] -- consider high < low - head $ [col highColor | x > hh ] ++ - [col normalColor | x > ll ] ++ + cols = map fromIntegral $ sort [l, h] -- consider high < low + head $ [col highColor | x > cols !! 1 ] ++ + [col normalColor | x > head cols ] ++ [col lowColor | True] showWithColors :: (Num a, Ord a) => (a -> String) -> a -> Monitor String @@ -260,11 +260,11 @@ logScaling f v = do h <- fromIntegral `fmap` getConfigValue high l <- fromIntegral `fmap` getConfigValue low bw <- fromIntegral `fmap` getConfigValue barWidth - let [ll, hh] = sort [l, h] + let ws = sort [l, h] bw' = if bw > 0 then bw else 10 scaled x | x == 0.0 = 0 - | x <= ll = 1 / bw' - | otherwise = f + logBase 2 (x / hh) / bw' + | x <= head ws = 1 / bw' + | otherwise = f + logBase 2 (x / ws !! 1) / bw' return $ scaled v showLogBar :: Float -> Float -> Monitor String diff --git a/src/Xmobar/Plugins/Monitors/Disk.hs b/src/Xmobar/Plugins/Monitors/Disk.hs index 47d1eac..95bcff6 100644 --- a/src/Xmobar/Plugins/Monitors/Disk.hs +++ b/src/Xmobar/Plugins/Monitors/Disk.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Disk --- Copyright : (c) 2010, 2011, 2012, 2014, 2018, 2019 Jose A Ortega Ruiz +-- Copyright : (c) 2010-2012, 2014, 2018, 2019, 2024 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> @@ -131,10 +131,9 @@ startDiskIO disks args rate cb = do runM args diskIOConfig (runDiskIO dref disks) rate cb runDiskU' :: DiskUOpts -> String -> [Integer] -> Monitor String -runDiskU' opts tmp stat = do +runDiskU' opts tmp (total:free:diff:_) = do setConfigValue tmp template - let [total, free, diff] = stat - strs = map sizeToStr [free, diff] + let strs = map sizeToStr [free, diff] freep = if total > 0 then free * 100 `div` total else 0 fr = fromIntegral freep / 100 s <- zipWithM showWithColors' strs [freep, 100 - freep] @@ -146,6 +145,7 @@ runDiskU' opts tmp stat = do uvb <- showVerticalBar (fromIntegral $ 100 - freep) (1 - fr) uipat <- showIconPattern (usedIconPattern opts) (1 - fr) parseTemplate $ [sizeToStr total] ++ s ++ sp ++ [fb,fvb,fipat,ub,uvb,uipat] +runDiskU' _ _ _ = return "" runDiskU :: [(String, String)] -> [String] -> Monitor String runDiskU disks argv = do diff --git a/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc index 296ba6c..b5530f1 100644 --- a/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc +++ b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc @@ -39,7 +39,7 @@ import Xmobar.Plugins.Monitors.Disk.Common ( , Path ) -import qualified Control.Exception.Extensible as E +import qualified Control.Exception as E import qualified Data.List as DL import qualified Data.Map as DM import qualified Data.Set as DS diff --git a/src/Xmobar/Plugins/Monitors/MPD.hs b/src/Xmobar/Plugins/Monitors/MPD.hs index 7ecbc0c..b091147 100644 --- a/src/Xmobar/Plugins/Monitors/MPD.hs +++ b/src/Xmobar/Plugins/Monitors/MPD.hs @@ -109,8 +109,9 @@ parseMPD (Right st) song opts = do 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 = showTime $ floor p + len = showTime $ floor t + remain = showTime $ 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 --git a/src/Xmobar/Plugins/Monitors/Mem/Linux.hs b/src/Xmobar/Plugins/Monitors/Mem/Linux.hs index 79dcc9d..7a81c6d 100644 --- a/src/Xmobar/Plugins/Monitors/Mem/Linux.hs +++ b/src/Xmobar/Plugins/Monitors/Mem/Linux.hs @@ -25,9 +25,13 @@ parseMEM = let content = map words $ take 8 $ lines file info = M.fromList $ map ( \line -> (head line, (read $ line !! 1 :: Float) / 1024)) content - [total, free, buffer, cache] = - map (info M.!) ["MemTotal:", "MemFree:", "Buffers:", "Cached:"] - available = M.findWithDefault (free + buffer + cache) "MemAvailable:" info + info' x = info M.! (x ++ ":") + total = info' "MemTotal" + free = info' "MemFree" + buffer = info' "Buffers" + cache = info' "Cached" + available = + M.findWithDefault (free + buffer + cache) "MemAvailable:" info used = total - available usedratio = used / total freeratio = free / total diff --git a/src/Xmobar/Plugins/Monitors/Mpris.hs b/src/Xmobar/Plugins/Monitors/Mpris.hs index ee30ad3..eb9595b 100644 --- a/src/Xmobar/Plugins/Monitors/Mpris.hs +++ b/src/Xmobar/Plugins/Monitors/Mpris.hs @@ -28,7 +28,7 @@ import qualified DBus.Client as DC import Control.Arrow ((***)) import Data.Maybe ( fromJust ) import Data.Int ( Int32, Int64 ) -import Data.Word ( Word32 ) +import Data.Word ( Word32, Word64 ) import System.IO.Unsafe ( unsafePerformIO ) import Control.Exception (try) @@ -136,17 +136,17 @@ makeList version md = map getStr (fieldsList version) where "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 + plen str num = case str of "mpris:length" -> formatTime (num `div` 1000000) - _ -> (show::Int64 -> String) num + _ -> show num getStr str = case lookup str md of Nothing -> "" Just v -> case variantType v of TypeString -> fromVar v TypeInt32 -> pInt str v TypeWord32 -> pw32 v - TypeInt64 -> plen str v + TypeWord64 -> plen str (fromVar v :: Word64) + TypeInt64 -> plen str (fromVar v :: Int64) TypeArray TypeString -> let x = arrayItems (fromVar v) in if null x then "" else fromVar (head x) diff --git a/src/Xmobar/Plugins/Monitors/Net/Linux.hs b/src/Xmobar/Plugins/Monitors/Net/Linux.hs index 9306497..f9cbc28 100644 --- a/src/Xmobar/Plugins/Monitors/Net/Linux.hs +++ b/src/Xmobar/Plugins/Monitors/Net/Linux.hs @@ -47,7 +47,10 @@ isUp d = flip catchIOError (const $ return False) $ do return $! (head . B.lines) operstate `elem` ["up", "unknown"] readNetDev :: [String] -> IO NetDevRawTotal -readNetDev ~[d, x, y] = do +readNetDev ds = do + let (d, x, y) = case ds of + d':x':y':_ -> (d', x', y') + _ -> ("", "", "") up <- unsafeInterleaveIO $ isUp d return $ N d (if up then ND (r x) (r y) else NI) where r s | s == "" = 0 diff --git a/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc index 9c74e36..90c58c1 100644 --- a/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc +++ b/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc @@ -71,11 +71,10 @@ instance Storable SwapData where poke _ _ = pure () - isEnabled :: IO Bool isEnabled = do - enabled <- sysctlReadUInt "vm.swap_enabled" - return $ enabled == 1 + nswapdev <- sysctlReadUInt "vm.nswapdev" + return $ nswapdev > 0 parseMEM' :: Bool -> IO [Float] parseMEM' False = return [] diff --git a/src/Xmobar/Plugins/Monitors/Top.hs b/src/Xmobar/Plugins/Monitors/Top.hs index 3bfe6fd..b2e573b 100644 --- a/src/Xmobar/Plugins/Monitors/Top.hs +++ b/src/Xmobar/Plugins/Monitors/Top.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top --- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018, 2022 Jose A Ortega Ruiz +-- Copyright : (c) 2010-2014, 2018, 2022, 2025 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> @@ -20,7 +20,7 @@ import Xmobar.Plugins.Monitors.Common import Data.IORef (newIORef, readIORef, writeIORef) import Data.List (sortBy) -import Data.Ord (comparing) +import Data.Ord (comparing, Down (..)) import Data.Time.Clock (getCurrentTime, diffUTCTime) import Xmobar.Plugins.Monitors.Top.Common ( @@ -66,7 +66,7 @@ showInfo nm sms mms = do sortTop :: [(String, Float)] -> [(String, Float)] -sortTop = sortBy (flip (comparing snd)) +sortTop = sortBy (comparing (Down . snd)) showMemInfo :: Float -> MemInfo -> Monitor [String] showMemInfo scale (nm, rss) = diff --git a/src/Xmobar/Plugins/Monitors/Weather.hs b/src/Xmobar/Plugins/Monitors/Weather.hs index e71de10..6b5c353 100644 --- a/src/Xmobar/Plugins/Monitors/Weather.hs +++ b/src/Xmobar/Plugins/Monitors/Weather.hs @@ -66,6 +66,7 @@ weatherConfig = mkMConfig , "skyCondition" , "skyConditionS" , "weather" + , "weatherS" , "tempC" , "tempF" , "dewPointC" @@ -221,23 +222,23 @@ getData station = CE.catch errHandler :: CE.SomeException -> IO String errHandler _ = return "<Could not retrieve data>" -formatSk :: Eq p => [(p, p)] -> p -> p -formatSk ((a,b):sks) sk = if a == sk then b else formatSk sks sk -formatSk [] sk = sk - formatWeather :: WeatherOpts -- ^ Formatting options from the cfg file -> [(String,String)] -- ^ 'SkyConditionS' for 'WeatherX' -> [WeatherInfo] -- ^ The actual weather info -> Monitor String -formatWeather opts sks [WI st ss y m d h (WindInfo wc wa wm wk wkh wms) v sk we tC tF dC dF r p] = - do cel <- showWithColors show tC +formatWeather opts sks [WI st ss y m d h wind v sk we tC tF dC dF r p] = + do let WindInfo wc wa wm wk wkh wms = wind + cel <- showWithColors show tC far <- showWithColors show tF - let sk' = formatSk sks (map toLower sk) - we' = showWeather (weatherString opts) we + let we' = showWeather (weatherString opts) we + sk' = findSk sks (map toLower sk) we' + we'' = findSk sks (map toLower we') sk' parseTemplate [st, ss, y, m, d, h, wc, wa, wm, wk, wkh - , wms, v, sk, sk', we', cel, far + , wms, v, sk, sk', we', we'', cel, far , show dC, show dF, show r , show p ] + where findSk ((a,b):xs) x df = if a == x then b else findSk xs x df + findSk [] _ df = df formatWeather _ _ _ = getConfigValue naString -- | Show the 'weather' field with a default string in case it was empty. diff --git a/src/Xmobar/Plugins/PacmanUpdates.hs b/src/Xmobar/Plugins/PacmanUpdates.hs new file mode 100644 index 0000000..03b556f --- /dev/null +++ b/src/Xmobar/Plugins/PacmanUpdates.hs @@ -0,0 +1,149 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Plugins.Monitors.PacmanUpdates +Copyright : (c) 2024, 2026 Enrico Maria De Angelis + , (c) 2025 Alexander Pankoff + , (c) 2026 Enrico Maria De Angelis +License : BSD-style (see LICENSE) + +Maintainer : Enrico Maria De Angelis <enricomaria.dean6elis@gmail.com> +Stability : unstable +Portability : unportable + +A Pacman updates availablility plugin for Xmobar. It also informs whether a kernel update is +available (provided the name of the kernel package), and whether the running kernel is older +than the installed one. +-} +module Xmobar.Plugins.PacmanUpdates ( + {-# DEPRECATED "This ctor is DEPRECATED; please use `PacmanUpdates` type and `PacmanUpdatesK` and `PacmanUpdatesNoK` constructors instead." #-} + pattern PacmanUpdates + , PacmanUpdates () + , pattern PacmanUpdatesK + , pattern PacmanUpdatesNoK) where + +import System.Exit (ExitCode (..)) +import System.Process (readProcessWithExitCode) +import Xmobar.Plugins.Command (Rate) +import Xmobar.Run.Exec +import Data.Tuple.Extra (fst3) +import Data.Kind (Type) +import Data.Functor ((<&>)) +import Data.Void (Void) +import Control.Arrow ((&&&)) +import qualified Data.Vector as V + +-- | Deprecated plugin ctor (will be deleted in 2027). +-- Use `PacmanUpdatesK` or `PacmanUpdatesNoK` instead. +pattern PacmanUpdates :: (String, String, String, String) -- ^ `String`s to be shown for 0, 1, ≥ 2 updates, + -- and for error respectively (in the 3rd string, for + -- ≥ 2 updates, any occurrence of the '?' character + -- is a placeholder for the number of available updates). + -> Rate -- ^ `Rate` of update (see [Xmobar doc](https://codeberg.org/xmobar/xmobar/src/commit/39fd70308c3aef5402abe7152ade76ff7bb331bb/src/Xmobar/Plugins/Command.hs#L34)). + -> PacmanUpdates False +pattern PacmanUpdates irrelevant <- (error "PacmanUpdates: PacmanUpdates is a build-only pattern synonym (a ctor synonym)." -> irrelevant) + where PacmanUpdates zome r + = let (z, o, m, e) = zome + printer = const + $ (++ deprecationNote) + . \case Left _ -> e + Right 0 -> z + Right 1 -> o + Right n -> m >>= \c -> if c == '?' + then show n + else pure c + deprecationNote = " <fc=#ff0000>(<action=`xdg-open https://codeberg.org/xmobar/xmobar/pulls/765`>" + ++ "deprecated plugin, click here</action>)</fc>" + in PacmanUpdatesNoK r printer + +-- | PacmanUpdates plugin parametrized over `Bool` kind: if `True` the plugin +-- will detect if there's pending update(s) for the kernel package; if `False` +-- it wont. +data PacmanUpdates (b :: Bool) + = Make -- ^ Constructor. + Rate -- ^ `Rate` of update (see [Xmobar doc](https://codeberg.org/xmobar/xmobar/src/commit/39fd70308c3aef5402abe7152ade76ff7bb331bb/src/Xmobar/Plugins/Command.hs#L34)). + (Arg b) -- ^ Optional further argument. See instances of `Updates`. + (Printer b) -- ^ Printer. See instances of `Updates` for its signature. + +instance Show (PacmanUpdates b) where + show = error "PacmanUpdates: Show instance is stub" + +instance Read (PacmanUpdates b) where + readsPrec = error "PacmanUpdates: Read instance is stub" + +instance Updates b => Exec (PacmanUpdates (b :: Bool)) where + alias = const "pacman" + rate (Make r _ _) = r + run = Xmobar.Plugins.PacmanUpdates.run' + +class Updates (b :: Bool) where + -- | See `Updates`'s instances. + type Arg b = (a :: Type) | a -> b + -- | See `Updates`'s instances. + type Printer b = (p :: Type) | p -> b + -- | This is the implementation of `Xmobar.Run.Exec.run`. + run' :: PacmanUpdates b -> IO String + +-- | No additional argument required for constructing the plugin; +-- the user-provided printer is fed with a `Bool` telling whether +-- the system is running an outdated kernel, and an `Int` telling +-- the number of available updates (or `Left` if an error occurred +-- when calling `checkupdates`). +instance Updates False where + type Arg False = Void + type Printer False = Bool -> Either String Int -> String + run' (Make _ _ printer) + = printer + <$> kernIsOld + <*> (fmap V.length <$> checkUpdates) + +-- | Constructing the plugin requires an additional `String` telling the name +-- name of the kernel package; the user-provided printer is fed with a `Bool` +-- telling whether the system is running an outdated kernel, and an `(Int, +-- Bool)` pair telling the number of available updates and whether one of these +-- is a kernel update (or `Left` if an error occurred when calling +-- `checkupdates`). +instance Updates True where + type Arg True = String + type Printer True = Bool -> Either String (Int, Bool) -> String + run' (Make _ kernName printer) + = printer + <$> kernIsOld + <*> (fmap (V.length &&& elem kernName) <$> checkUpdates) + +-- | Pattern synonym used to construct a `PacmanUpdates True`. +pattern PacmanUpdatesK :: Rate -> Arg True -> Printer True -> PacmanUpdates True +pattern PacmanUpdatesK r a p = Make r a p + +-- | Pattern synonym used to construct a `PacmanUpdates False`. +pattern PacmanUpdatesNoK :: Rate -> Printer False -> PacmanUpdates False +pattern PacmanUpdatesNoK r p <- Make r _ p + where PacmanUpdatesNoK r p = Make r undefined p + +checkUpdates :: IO (Either String (V.Vector String)) +checkUpdates = readProcessWithExitCode "checkupdates" [] "" + <&> \case (ExitFailure 2, "", "") -> Right V.empty + (ExitSuccess, stdout, "") + -> let pkgName = takeWhile (/= ' ') + pkgs = V.fromList $ fmap pkgName $ lines stdout + in case V.length pkgs of + 0 -> impossible + _ -> Right pkgs + (ExitFailure 1, _, _) -> Left "checkupdates: unknown cause of failure." + _ -> impossible + +kernIsOld :: IO Bool +kernIsOld = (/= ExitSuccess) . exitCode <$> readProcessWithExitCode "modinfo" ["-n", "i915"] "" + where exitCode = fst3 + +impossible :: a +impossible = error "This is impossible, according to my knowledge." diff --git a/src/Xmobar/Run/Actions.hs b/src/Xmobar/Run/Actions.hs index 51dbb85..cbc10c5 100644 --- a/src/Xmobar/Run/Actions.hs +++ b/src/Xmobar/Run/Actions.hs @@ -16,7 +16,7 @@ module Xmobar.Run.Actions ( Button , runAction' , stripActions) where -import System.Process (spawnCommand) +import System.Process (spawnCommand, waitForProcess) import Control.Monad (void) import Text.Regex (Regex, subRegex, mkRegex, matchRegex) import Data.Word (Word32) @@ -26,11 +26,11 @@ type Button = Word32 data Action = Spawn [Button] String deriving (Eq, Read, Show) runAction :: Action -> IO () -runAction (Spawn _ s) = void $ spawnCommand s +runAction (Spawn _ s) = void $ spawnCommand (s ++ " &") >>= waitForProcess -- | Run action with stdout redirected to stderr runAction' :: Action -> IO () -runAction' (Spawn _ s) = void $ spawnCommand (s ++ " 1>&2") +runAction' (Spawn _ s) = void $ spawnCommand (s ++ " 1>&2 &") >>= waitForProcess stripActions :: String -> String stripActions s = case matchRegex actionRegex s of diff --git a/src/Xmobar/Run/Loop.hs b/src/Xmobar/Run/Loop.hs index bda41ff..6775961 100644 --- a/src/Xmobar/Run/Loop.hs +++ b/src/Xmobar/Run/Loop.hs @@ -57,7 +57,7 @@ type LoopFunction = TMVar SignalType -> TVar [String] -> IO () loop :: Config -> LoopFunction -> IO () loop conf looper = withDeferSignals $ do - cls <- mapM (parseTemplate (commands conf) (sepChar conf)) + let cls = map (parseTemplate (commands conf) (sepChar conf)) (splitTemplate (alignSep conf) (template conf)) let confSig = unSignalChan (signal conf) sig <- maybe newEmptyTMVarIO pure confSig diff --git a/src/Xmobar/Run/Template.hs b/src/Xmobar/Run/Template.hs index 87c84d3..0e066dc 100644 --- a/src/Xmobar/Run/Template.hs +++ b/src/Xmobar/Run/Template.hs @@ -50,21 +50,20 @@ templateParser s = many $ templateStringParser s -- | Actually runs the template parsers over a (segment of) a template -- string, returning a list of runnables with their prefix and suffix. -parseTemplate :: [Runnable] -> String -> String -> IO [(Runnable,String,String)] +parseTemplate :: [Runnable] -> String -> String -> [(Runnable,String,String)] parseTemplate c sepChar s = - do str <- case parse (templateParser sepChar) "" s of - Left _ -> return [("", s, "")] - Right x -> return x - let cl = map alias c - m = Map.fromList $ zip cl c - return $ combine c m str + let str = case parse (templateParser sepChar) "" s of + Left _ -> [("", s, "")] + Right x -> x + cl = map alias c + m = Map.fromList $ zip cl c + in combine m str -- | Given a finite "Map" and a parsed template produce the resulting -- output string. -combine :: [Runnable] -> Map.Map String Runnable -> [(String, String, String)] - -> [(Runnable,String,String)] -combine _ _ [] = [] -combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs +combine :: Map.Map String Runnable -> [(String, String, String)] -> [(Runnable,String,String)] +combine _ [] = [] +combine m ((ts,s,ss):xs) = (com, s, ss) : combine m xs where com = Map.findWithDefault dflt ts m dflt = Run $ Com ts [] [] 10 @@ -77,5 +76,6 @@ splitTemplate alignSep template = (ce,_:ri) -> [le, ce, ri] _ -> def _ -> def - where [l, r] = if length alignSep == 2 then alignSep else defaultAlign + where sep = if length alignSep == 2 then alignSep else defaultAlign + (l, r) = (head sep, sep !! 1) def = [template, "", ""] diff --git a/src/Xmobar/Run/Types.hs b/src/Xmobar/Run/Types.hs index 69406bb..8b9caa4 100644 --- a/src/Xmobar/Run/Types.hs +++ b/src/Xmobar/Run/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TypeOperators, CPP #-} +{-# LANGUAGE DataKinds #-} ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Run.Types @@ -19,6 +20,7 @@ module Xmobar.Run.Types(runnableTypes) where import {-# SOURCE #-} Xmobar.Run.Runnable() +import Xmobar.Plugins.PacmanUpdates import Xmobar.Plugins.Command import Xmobar.Plugins.Monitors import Xmobar.Plugins.Date diff --git a/src/Xmobar/System/Environment.hs b/src/Xmobar/System/Environment.hs index 42483ca..0491bcc 100644 --- a/src/Xmobar/System/Environment.hs +++ b/src/Xmobar/System/Environment.hs @@ -36,12 +36,13 @@ expandEnv (c:s) = case c of False -> do remainder <- expandEnv $ drop 1 s return $ escString s ++ remainder - where escString s' = let (cc:_) = s' in + where escString (cc:_) = case cc of 't' -> "\t" 'n' -> "\n" '$' -> "$" _ -> [cc] + escString [] = "" _ -> do remainder <- expandEnv s diff --git a/src/Xmobar/X11/Bitmap.hs b/src/Xmobar/X11/Bitmap.hs index b14356f..c5304d9 100644 --- a/src/Xmobar/X11/Bitmap.hs +++ b/src/Xmobar/X11/Bitmap.hs @@ -2,7 +2,7 @@ ----------------------------------------------------------------------------- -- | -- Module : X11.Bitmap --- Copyright : (C) 2013, 2015, 2017, 2018, 2022 Alexander Polakov +-- Copyright : (C) 2013, 2015, 2017, 2018, 2022, 2024 Alexander Polakov -- License : BSD3 -- -- Maintainer : jao@gnu.org @@ -116,8 +116,9 @@ loadBitmap d w p = do drawBitmap :: Display -> Drawable -> GC -> String -> String -> Position -> Position -> Bitmap -> IO () drawBitmap d p gc fc bc x y i = - withColors d [fc, bc] $ \[fc', bc'] -> do - let w = width i + withColors d [fc, bc] $ \cs -> do + let (fc', bc') = (head cs, cs !! 1) + w = width i h = height i y' = 1 + y - fromIntegral h `div` 2 setForeground d gc fc' diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs index 6ddb693..0425cff 100644 --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -3,7 +3,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.App.X11EventLoop --- Copyright: (c) 2018, 2020, 2022, 2023 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2020, 2022, 2023, 2024 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -149,8 +149,7 @@ signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do parseSegments :: C.Config -> STM.TVar [String] -> IO [[C.Segment]] parseSegments conf v = do s <- STM.readTVarIO v - let l:c:r:_ = s ++ repeat "" - return $ map (CT.parseString conf) [l, c, r] + return $ map (CT.parseString conf) (take 3 $ s ++ repeat "") updateIconCache :: T.XConf -> [[C.Segment]] -> IO T.XConf updateIconCache xc@(T.XConf d _ w _ c cfg) segs = do @@ -171,7 +170,7 @@ updateConfigPosition disp cfg = runActions :: D.Actions -> A.Button -> X11.Position -> IO () runActions actions button pos = mapM_ A.runAction $ - filter (\(A.Spawn b _) -> button `elem` b) $ - concatMap (\(a,_,_) -> a) $ - filter (\(_, from, to) -> pos' >= from && pos' <= to) actions + concatMap + (filter (\ (A.Spawn b _) -> button `elem` b) . (\ (a, _, _) -> a)) + (filter (\ (_, from, to) -> pos' >= from && pos' <= to) actions) where pos' = fromIntegral pos diff --git a/xmobar.cabal b/xmobar.cabal index b8bdd79..5d4dd07 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -1,5 +1,5 @@ name: xmobar -version: 0.47.4 +version: 0.51 homepage: https://codeberg.org/xmobar/xmobar synopsis: A Minimalistic Text Based Status Bar description: Xmobar is a minimalistic text based status bar. @@ -26,6 +26,7 @@ extra-source-files: readme.org, changelog.md, etc/xmobar.hs, etc/xmonadpropwrite.hs, etc/xmobar.el + etc/notify-once.sh source-repository head type: git @@ -105,6 +106,7 @@ library hs-source-dirs: src exposed-modules: Xmobar, + Xmobar.Plugins.Accordion, Xmobar.Plugins.Monitors.Common.Types, Xmobar.Plugins.Monitors.Common.Run, Xmobar.Plugins.Monitors.Common, @@ -156,6 +158,7 @@ library Xmobar.Plugins.EWMH, Xmobar.Plugins.HandleReader, Xmobar.Plugins.QueueReader, + Xmobar.Plugins.PacmanUpdates, Xmobar.Plugins.PipeReader, Xmobar.Plugins.MarqueePipeReader, Xmobar.Plugins.StdinReader, @@ -198,13 +201,13 @@ library build-depends: aeson >= 1.4.7.1, async, - base >= 4.11.0 && < 4.20, + base >= 4.11.0 && < 4.22, bytestring >= 0.10.8.2, cairo >= 0.13, colour >= 2.3.6, containers, directory, - extensible-exceptions == 0.1.*, + extra, filepath, mtl >= 2.1 && < 2.4, old-locale, @@ -218,6 +221,7 @@ library transformers, unix, utf8-string >= 0.3 && < 1.1, + vector, X11 >= 1.6.1 if impl(ghc < 8.0.2) @@ -262,8 +266,8 @@ library cereal >= 0.5.8.1 cpp-options: -DUSE_NL80211 - if flag(with_mpd) || (flag(all_extensions) && impl(ghc < 9.4)) - build-depends: libmpd >= 0.9.2.0 + if flag(with_mpd) || flag(all_extensions) + build-depends: libmpd >= 0.10.0.1 other-modules: Xmobar.Plugins.Monitors.MPD cpp-options: -DLIBMPD |
