diff --git a/changelog.md b/changelog.md --- a/changelog.md +++ b/changelog.md @@ -1,3 +1,12 @@ +## Version 0.51 (June, 2026) + +- Improvements for `PacmanUpdates` (thanks, Enrico Maria and Alexander) +- Fixes and improvements to `Accordion` (thanks, Enrico Maria) +- Fixes to `Batt` (thanks, Leana) +- Fix BadDrawable crash when wallpaper setters free the root pixmap while + alpha is 255 (thanks, Ashesh) +- base dependency relaxed to 4.21 + ## Version 0.50 (June, 2025) - New plugins: `PacmanUpdates` (thanks, Alexander) diff --git a/doc/plugins.org b/doc/plugins.org --- a/doc/plugins.org +++ b/doc/plugins.org @@ -306,8 +306,8 @@ "--", "-O", "On - ", "-i", "", "-L", "-15", "-H", "-5", "-l", "red", "-m", "blue", "-h", "green", - "-a", "notify-send -u critical 'Battery running out!!'", - "-A", "3"] + "-a", "notify-once \"xmobar\" -u critical 'Battery running out!!' \"$XMOBAR_BATT_LEFT% Remains\"", + "-A", "6"] 600 #+end_src @@ -316,8 +316,23 @@ separator affect how == is displayed. For this monitor, neither the generic nor the specific options have any effect on ==. We are also telling the monitor to execute the unix command - =notify-send= when the percentage left in the battery reaches 6%. + =notify-once= when the percentage left in the battery reaches 6%. + =XMOBAR_BATT_LEFT= environment variable is made available to the program being called. + You can use it to make the alert message more informative. It is an integer between 0 and 100. + + =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: @@ -1355,6 +1370,7 @@ *** =PacmanUpdates (Zero, One, Many, Error) Rate= + - *This constructor is deprecated. Use =PacmanUpdatesK=, =PacmanUpdatesPredicateK=, 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. @@ -1364,26 +1380,87 @@ network error) - Example: #+begin_src haskell - ArchUpdates ("up to date", - "1 update, - "? updates", - "!Pacman Error!") + PacmanUpdates ("up to date", + "1 update, + "? updates", + "!Pacman Error!") 600 #+end_src -*** =ArchUpdates (Zero, One, Many) Rate= +*** =PacmanUpdatesK Rate KernName (Bool -> Either String (Int, Bool) -> String)= - - *This plugin is deprecated. Use =PacmanUpdates= instead.* - - Aliases to =arch= - - Same As: + - 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 - PacmanUpdates (Zero, - One, - Many, - "pacman: Unknown cause of failure.") - Rate + 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 +*** =PacmanUpdatesPredicateK Rate IsKernelUpdate (Bool -> Either String (Int, Bool) -> String)= + + - Aliases to =pacman= + - =IsKernelUpdate=: a =String -> Bool= predicate that receives each available + package name and returns =True= for kernel packages. This is useful for + distributions with versioned kernel package names, such as Manjaro's + =linux618= or =linux70= packages. + - =(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 + matches the kernel predicate (or an error message if =checkupdates= fails). + - Example: + This example requires =import Data.Char (isDigit)= and + =import Data.List (stripPrefix)= in your configuration. + #+begin_src haskell + PacmanUpdatesPredicateK + 600 + ( \packageName -> + case stripPrefix "linux" packageName of + Just n -> not (null n) && all isDigit n + Nothing -> False + ) + $ \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: @@ -1405,6 +1482,11 @@ - =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: diff --git a/etc/notify-once.sh b/etc/notify-once.sh new file mode 100644 --- /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 [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/readme.org b/readme.org --- a/readme.org +++ b/readme.org @@ -5,6 +5,9 @@ hackage + + status-badge +

#+end_export @@ -28,6 +31,11 @@ * Breaking news + - Starting with version 0.51, we introduced a new GHC support policy: xmobar + officially supports only the GHC versions that upstream marks as /suitable + for use/ in the [[https://gitlab.haskell.org/ghc/ghc/-/wikis/GHC-status][official GHC status overview]]. + At the time of writing, this means GHC versions from 9.6 to 9.14. + - 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 @@ -92,9 +100,6 @@ cabal install xmobar -fall_extensions #+end_src - Starting with version 0.35.1, xmobar requires at least GHC version - 8.4.x. to build. See [[https://codeberg.org/xmobar/xmobar/issues/461][this issue]] for more information. - See [[https://codeberg.org/xmobar/xmobar/src/branch/master/doc/compiling.org#optional-features][here]] for a list of optional compilation flags that will enable some optional plugins. @@ -163,12 +168,12 @@ the greater xmobar and Haskell communities. In particular, xmobar incorporates patches by Kostas Agnantis, Mohammed - Alshiekh, Alex Ameen, Axel Angel, Enrico Maria De Angelis, Dhananjay Balan, + Alshiekh, Ashesh Ambasta, 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, + Joule, Spencer Janssen, Léana 江, 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 @@ -193,6 +198,6 @@ 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-2025 Jose Antonio Ortega Ruiz + Copyright © 2010-2026 Jose Antonio Ortega Ruiz Copyright © 2007-2010 Andrea Rossato diff --git a/src/Xmobar.hs b/src/Xmobar.hs --- 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,15 +19,13 @@ , 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.ArchUpdates , module Xmobar.Plugins.BufferedPipeReader , module Xmobar.Plugins.CommandReader , module Xmobar.Plugins.Date @@ -57,7 +55,6 @@ import Xmobar.Config.Types import Xmobar.Config.Parse import Xmobar.Plugins.Accordion -import Xmobar.Plugins.ArchUpdates import Xmobar.Plugins.Command import Xmobar.Plugins.BufferedPipeReader import Xmobar.Plugins.CommandReader diff --git a/src/Xmobar/App/Compile.hs b/src/Xmobar/App/Compile.hs --- 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,8 +20,8 @@ module Xmobar.App.Compile(recompile, trace, xmessage) where import Control.Monad.IO.Class -import Control.Exception.Extensible (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 System.FilePath((), takeExtension) @@ -141,7 +141,7 @@ else shouldRecompile verb src bin lib if sc then do - status <- bracket (openFile err WriteMode) hClose $ + status <- withFile err WriteMode $ \errHandle -> waitForProcess =<< if useScript diff --git a/src/Xmobar/App/Opts.hs b/src/Xmobar/App/Opts.hs --- 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, 2025 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 @@ , 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 @@ info :: String info = "xmobar " ++ showVersion version - ++ "\n (C) 2010 - 2025 Jose A Ortega Ruiz" + ++ "\n (C) 2010 - 2026 Jose A Ortega Ruiz" ++ "\n (C) 2007 - 2010 Andrea Rossato\n " ++ mail ++ "\n" ++ license ++ "\n" diff --git a/src/Xmobar/Plugins/Accordion.hs b/src/Xmobar/Plugins/Accordion.hs --- a/src/Xmobar/Plugins/Accordion.hs +++ b/src/Xmobar/Plugins/Accordion.hs @@ -1,4 +1,5 @@ {-# LANGUAGE TupleSections, FlexibleContexts #-} +{-# LANGUAGE RecordWildCards #-} ----------------------------------------------------------------------------- -- | @@ -17,16 +18,17 @@ module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, makeAccordion', Tuning(..)) where -import Control.Concurrent.Async (withAsync) +import Control.Concurrent.Async (concurrently_, mapConcurrently_) import Control.Exception (finally) -import Control.Monad (forever, join, when) -import Control.Monad.IO.Class (liftIO) -import Control.Monad.Reader (runReaderT, ask) -import Control.Monad.State.Strict (evalStateT, get, modify') +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 Data.Maybe (isJust) +import GHC.IO.Handle.FD (withFileBlocking) import System.Directory (removeFile) -import System.Exit (ExitCode(..)) +import System.IO (IOMode(ReadMode), hGetContents') import System.Process (readProcessWithExitCode) import Xmobar.Run.Exec (Exec(..), tenthSeconds) @@ -62,52 +64,49 @@ , shrink = "><" } -instance (Exec a, Read a, Show a) => Exec (Accordion a) where - alias (Accordion Tuning { alias' = name } _ _) = name - start (Accordion Tuning { initial = initial' - , expand = expandIcon - , shrink = shrinkIcon } - runnables - shortRunnables) - cb = do - clicked <- newIORef Nothing +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] "" - withAsync (forever $ do (ret, _, _) <- readProcessWithExitCode "cat" [pipe] "" - case ret of - ExitSuccess -> atomicModifyIORef' clicked (const (Just (), ())) - ExitFailure _ -> error "how is this possible?") - (const $ do - strRefs <- mapM (newIORef . const "") runnables - strRefs' <- mapM (newIORef . const "") shortRunnables - foldr (\(runnable, strRef) acc -> withAsync (start runnable (writeToRef strRef)) (const acc)) - (forever (do liftIO (tenthSeconds 1) - clicked' <- liftIO $ readIORef clicked - when (isJust clicked') - (do liftIO $ clear clicked - modify' not) - b <- get - loop b pipe) - `runReaderT` (strRefs, strRefs') - `evalStateT` initial') - (zip (runnables ++ shortRunnables) - (strRefs ++ strRefs'))) + 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 b p = do + 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 b then strRefs else strRefs') - liftIO $ cb $ text ++ attachClick p (if b then shrinkIcon else expandIcon) + 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 (Maybe a) -> IO () -clear = (`atomicModifyIORef'` const (Nothing, ())) +clear :: IORef Bool -> IO () +clear = (`atomicModifyIORef'` const (False, ())) removeLinebreak :: [a] -> [a] removeLinebreak = init attachClick :: String -> String -> String -attachClick file icon = " " ++ file ++ "`>" ++ icon ++ "" +attachClick file icon = " " ++ file ++ "`>" ++ icon ++ "" diff --git a/src/Xmobar/Plugins/ArchUpdates.hs b/src/Xmobar/Plugins/ArchUpdates.hs deleted file mode 100644 --- a/src/Xmobar/Plugins/ArchUpdates.hs +++ /dev/null @@ -1,36 +0,0 @@ -{-# LANGUAGE CPP #-} - ------------------------------------------------------------------------------ - ------------------------------------------------------------------------------ - -{- | -Module : Plugins.Monitors.ArchUpdates -Copyright : (c) 2024 Enrico Maria De Angelis -License : BSD-style (see LICENSE) - -Maintainer : Enrico Maria De Angelis -Stability : unstable -Portability : unportable - -An ArchLinux updates availablility plugin for Xmobar --} -module Xmobar.Plugins.ArchUpdates (ArchUpdates (..)) where - -import Xmobar.Plugins.Command (Rate) -import Xmobar.Plugins.PacmanUpdates (PacmanUpdates (PacmanUpdates)) -import Xmobar.Run.Exec - -data ArchUpdates = ArchUpdates (String, String, String) Rate - deriving (Read, Show) - -intoPacmanUpdates :: ArchUpdates -> PacmanUpdates -intoPacmanUpdates (ArchUpdates (z, o, m) r) = - PacmanUpdates (z <> deprecation, o, m, "pacman: Unknown cause of failure.") r - where - deprecation = " (deprecated plugin, click here)" - -instance Exec ArchUpdates where - alias = const "arch" - rate = rate . intoPacmanUpdates - run = run . intoPacmanUpdates diff --git a/src/Xmobar/Plugins/EWMH.hs b/src/Xmobar/Plugins/EWMH.hs --- a/src/Xmobar/Plugins/EWMH.hs +++ b/src/Xmobar/Plugins/EWMH.hs @@ -232,7 +232,7 @@ 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/Monitors/Batt/Common.hs b/src/Xmobar/Plugins/Monitors/Batt/Common.hs --- a/src/Xmobar/Plugins/Monitors/Batt/Common.hs +++ b/src/Xmobar/Plugins/Monitors/Batt/Common.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeApplications #-} ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Batt.Common @@ -18,7 +19,8 @@ , Status(..) , maybeAlert) where -import System.Process (spawnCommand, waitForProcess) +import System.Environment +import System.Process (waitForProcess, withCreateProcess, shell, CreateProcess(env)) import Control.Monad (unless, void) import Xmobar.Plugins.Monitors.Common @@ -54,4 +56,11 @@ case onLowAction opts of Nothing -> return () Just x -> unless (isNaN left || actionThreshold opts < 100 * left) - $ void $ spawnCommand (x ++ " &") >>= waitForProcess + $ runCmd =<< mkShellCmd x + where + mkShellCmd command = do + selfEnv <- getEnvironment + pure (shell command) { env = Just $ ("XMOBAR_BATT_LEFT", show @Int $ round $ 100 * left) : selfEnv + } + runCmd c = withCreateProcess c $ \_ _ _ ph -> + void $ waitForProcess ph diff --git a/src/Xmobar/Plugins/Monitors/Batt/Linux.hs b/src/Xmobar/Plugins/Monitors/Batt/Linux.hs --- a/src/Xmobar/Plugins/Monitors/Batt/Linux.hs +++ b/src/Xmobar/Plugins/Monitors/Batt/Linux.hs @@ -199,5 +199,5 @@ | time == 0 = Idle | ac = Charging | otherwise = Discharging - unless ac (maybeAlert opts left) + unless (racst == Charging || racst == Idle) $ maybeAlert opts left return $ if isNaN left then NA else Result left watts time racst diff --git a/src/Xmobar/Plugins/Monitors/Bright.hs b/src/Xmobar/Plugins/Monitors/Bright.hs --- a/src/Xmobar/Plugins/Monitors/Bright.hs +++ b/src/Xmobar/Plugins/Monitors/Bright.hs @@ -54,11 +54,12 @@ , fMax :: String } | NoFiles + deriving Show brightFiles :: BrightOpts -> IO Files brightFiles opts = do is_curr <- fileExist $ fCurr files - is_max <- fileExist $ fCurr files + is_max <- fileExist $ fMax files return (if is_curr && is_max then files else NoFiles) where prefix = sysDir subDir opts files = Files { fCurr = prefix currBright opts diff --git a/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc --- a/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc +++ b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc @@ -39,7 +39,7 @@ , 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/PacmanUpdates.hs b/src/Xmobar/Plugins/PacmanUpdates.hs --- a/src/Xmobar/Plugins/PacmanUpdates.hs +++ b/src/Xmobar/Plugins/PacmanUpdates.hs @@ -1,4 +1,9 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilyDependencies #-} +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE ViewPatterns #-} ----------------------------------------------------------------------------- @@ -6,38 +11,155 @@ {- | Module : Plugins.Monitors.PacmanUpdates -Copyright : (c) 2024 Enrico Maria De Angelis +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 Stability : unstable Portability : unportable -A Pacman updates availablility plugin for Xmobar +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 (PacmanUpdates (..)) where +module Xmobar.Plugins.PacmanUpdates ( +#if __GLASGOW_HASKELL__ >= 908 + {-# DEPRECATED "This ctor is DEPRECATED; please use `PacmanUpdates` type and `PacmanUpdatesK`, `PacmanUpdatesPredicateK` and `PacmanUpdatesNoK` constructors instead." #-} +#endif + pattern PacmanUpdates + , PacmanUpdates () + , PacmanUpdatesKernelCheck (..) + , pattern PacmanUpdatesK + , pattern PacmanUpdatesPredicateK + , 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 -data PacmanUpdates = PacmanUpdates (String, String, String, String) Rate - deriving (Read, Show) +-- | Deprecated plugin ctor (will be deleted in 2027). +-- Use `PacmanUpdatesK`, `PacmanUpdatesPredicateK`, 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 NoKernelCheck +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 = " (" + ++ "deprecated plugin, click here)" + in PacmanUpdatesNoK r printer -instance Exec PacmanUpdates where + +-- | Different types of kernel checks. +data PacmanUpdatesKernelCheck = NoKernelCheck | PredicateKernelCheck + +-- | PacmanUpdates plugin parametrized over the `PacmanUpdatesKernelCheck` kind. +data PacmanUpdates (b :: PacmanUpdatesKernelCheck) + = 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 :: PacmanUpdatesKernelCheck)) where alias = const "pacman" - rate (PacmanUpdates _ r) = r - run (PacmanUpdates (z, o, m, e) _) = do - (exit, stdout, _) <- readProcessWithExitCode "checkupdates" [] "" - return $ case exit of - ExitFailure 2 -> z -- ero updates - ExitFailure 1 -> e - ExitSuccess -> case length $ lines stdout of - 0 -> impossible - 1 -> o - n -> m >>= \c -> if c == '?' then show n else pure c - _ -> impossible - where - impossible = error "This is impossible based on pacman manpage" + rate (Make r _ _) = r + run = Xmobar.Plugins.PacmanUpdates.run' + +class Updates (b :: PacmanUpdatesKernelCheck) 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 NoKernelCheck where + type Arg NoKernelCheck = Void + type Printer NoKernelCheck = Bool -> Either String Int -> String + run' (Make _ _ printer) + = printer + <$> kernIsOld + <*> (fmap V.length <$> checkUpdates) + +-- | Constructing the plugin requires an additional `String -> Bool` predicate +-- that receives each available package name and returns `True` for kernel +-- packages; 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 PredicateKernelCheck where + type Arg PredicateKernelCheck = String -> Bool + type Printer PredicateKernelCheck = Bool -> Either String (Int, Bool) -> String + run' (Make _ checkKern printer) + = printer + <$> kernIsOld + <*> (fmap (V.length &&& V.any checkKern) <$> checkUpdates) + +-- | Pattern synonym to construct a `PacmanUpdates PredicateKernelCheck` that +-- detects updates for packages matched by the given @(String -> Bool)@ +-- predicate. This can be used to detect kernel updates for distributions +-- with versioned kernel package names (e.g. Manjaro's @linux618@) +pattern PacmanUpdatesPredicateK :: Rate -> Arg PredicateKernelCheck -> Printer PredicateKernelCheck -> PacmanUpdates PredicateKernelCheck +pattern PacmanUpdatesPredicateK r a p = Make r a p + +-- | A convenience wrapper around PacmanUpdatesPredicateK with the predicate @(== kernName)@ +-- Construction only: the kernel name cannot be recovered when matching. +pattern PacmanUpdatesK :: Rate -> String -> Printer PredicateKernelCheck -> PacmanUpdates PredicateKernelCheck +pattern PacmanUpdatesK r kernName p <- + (error "PacmanUpdatesK: build-only pattern synonym (a ctor synonym)." -> (r, kernName, p)) + where PacmanUpdatesK r kernName p = PacmanUpdatesPredicateK r (== kernName) p + +-- | Pattern synonym used to construct a `PacmanUpdates NoKernelCheck`. +pattern PacmanUpdatesNoK :: Rate -> Printer NoKernelCheck -> PacmanUpdates NoKernelCheck +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 --- a/src/Xmobar/Run/Actions.hs +++ b/src/Xmobar/Run/Actions.hs @@ -16,7 +16,7 @@ , runAction' , stripActions) where -import System.Process (spawnCommand, waitForProcess) +import System.Process (shell, withCreateProcess, waitForProcess) import Control.Monad (void) import Text.Regex (Regex, subRegex, mkRegex, matchRegex) import Data.Word (Word32) @@ -26,11 +26,12 @@ data Action = Spawn [Button] String deriving (Eq, Read, Show) runAction :: Action -> IO () -runAction (Spawn _ s) = void $ spawnCommand (s ++ " &") >>= waitForProcess +runAction (Spawn _ s) = withCreateProcess (shell s) $ \_ _ _ ph -> + void $ waitForProcess ph -- | Run action with stdout redirected to stderr runAction' :: Action -> IO () -runAction' (Spawn _ s) = void $ spawnCommand (s ++ " 1>&2 &") >>= waitForProcess +runAction' (Spawn btn s) = runAction (Spawn btn (s ++ " 1>&2")) stripActions :: String -> String stripActions s = case matchRegex actionRegex s of diff --git a/src/Xmobar/Run/Loop.hs b/src/Xmobar/Run/Loop.hs --- a/src/Xmobar/Run/Loop.hs +++ b/src/Xmobar/Run/Loop.hs @@ -57,7 +57,7 @@ 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 --- a/src/Xmobar/Run/Template.hs +++ b/src/Xmobar/Run/Template.hs @@ -50,21 +50,20 @@ -- | 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 diff --git a/src/Xmobar/Run/Types.hs b/src/Xmobar/Run/Types.hs --- 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,7 +20,7 @@ module Xmobar.Run.Types(runnableTypes) where import {-# SOURCE #-} Xmobar.Run.Runnable() -import Xmobar.Plugins.ArchUpdates +import Xmobar.Plugins.PacmanUpdates import Xmobar.Plugins.Command import Xmobar.Plugins.Monitors import Xmobar.Plugins.Date @@ -60,7 +61,6 @@ runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*: NotmuchMail :*: - ArchUpdates :*: #ifdef INOTIFY Mail :*: MBox :*: #endif diff --git a/src/Xmobar/X11/XRender.hsc b/src/Xmobar/X11/XRender.hsc --- a/src/Xmobar/X11/XRender.hsc +++ b/src/Xmobar/X11/XRender.hsc @@ -91,22 +91,28 @@ withRenderFill d (XRenderColor 0 0 0 (257 * alpha)) (render pictOpSrc bgfill pic) - -- Handle transparency - internAtom d "_XROOTPMAP_ID" False >>= \xid -> - let xroot = defaultRootWindow d in - alloca $ \x1 -> - alloca $ \x2 -> - alloca $ \x3 -> - alloca $ \x4 -> - alloca $ \pprop -> do - xGetWindowProperty d xroot xid 0 1 False 20 x1 x2 x3 x4 pprop - prop <- peek pprop - when (prop /= nullPtr) $ do - rootbg <- peek (castPtr prop) :: IO Pixmap - xFree prop - withRenderPicture d rootbg $ \bgpic -> - withRenderFill d (XRenderColor 0 0 0 (0xFFFF - 257 * alpha)) - (render pictOpAdd bgpic pic) + -- Handle pseudo-transparency by compositing the root pixmap. + -- Skip entirely when alpha == 255 (fully opaque) since the blend + -- factor would be zero, making this a no-op. More importantly, + -- the root pixmap (_XROOTPMAP_ID) can be freed at any time by + -- wallpaper setters like feh (via XKillClient), causing a + -- BadDrawable crash in XRenderCreatePicture if we touch it. + when (alpha < 255) $ + internAtom d "_XROOTPMAP_ID" False >>= \xid -> + let xroot = defaultRootWindow d in + alloca $ \x1 -> + alloca $ \x2 -> + alloca $ \x3 -> + alloca $ \x4 -> + alloca $ \pprop -> do + xGetWindowProperty d xroot xid 0 1 False 20 x1 x2 x3 x4 pprop + prop <- peek pprop + when (prop /= nullPtr) $ do + rootbg <- peek (castPtr prop) :: IO Pixmap + xFree prop + withRenderPicture d rootbg $ \bgpic -> + withRenderFill d (XRenderColor 0 0 0 (0xFFFF - 257 * alpha)) + (render pictOpAdd bgpic pic) -- | Parses color into XRender color (allocation not necessary!) parseRenderColor :: Display -> String -> IO XRenderColor diff --git a/test/Xmobar/Plugins/Monitors/CpuSpec.hs b/test/Xmobar/Plugins/Monitors/CpuSpec.hs --- a/test/Xmobar/Plugins/Monitors/CpuSpec.hs +++ b/test/Xmobar/Plugins/Monitors/CpuSpec.hs @@ -6,24 +6,38 @@ import Test.Hspec import Xmobar.Plugins.Monitors.Common import Xmobar.Plugins.Monitors.Cpu + import Data.List +import Text.Regex.TDFA((=~)) main :: IO () main = hspec spec +withFc :: String -> String +withFc s = "(()?" ++ s ++ "()?)" + +withFcDigits :: String -> String -> String +withFcDigits prefix suffix = prefix ++ digits ++ suffix + where digits = withFc "([0-9][0-9]?|-0)" -- in CI computers, -0 is a value + spec :: Spec spec = describe "CPU Spec" $ do + it "uses the correct regexps" $ + do "Cpu: -0%" `shouldSatisfy` (=~ withFcDigits "Cpu: " "%") + "Cpu: 12" `shouldSatisfy` (=~ withFcDigits "Cpu: " "") + "Cpu: 12" `shouldSatisfy` (=~ withFcDigits "Cpu: " "") + "Cpu: 12 -0" `shouldSatisfy` (=~ withFcDigits "Cpu: (" ")+") it "works with total template" $ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: %"] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs - cpuValue `shouldSatisfy` (\item -> "Cpu:" `isPrefixOf` item) + cpuValue `shouldSatisfy` (=~ withFcDigits "Cpu: " "%") it "works with bar template" $ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: % "] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs - cpuValue `shouldSatisfy` (all (`elem` ":#") . last . words) + cpuValue `shouldSatisfy` ((=~ (withFc "#+" ++ "?:*")) . last . words) it "works with no icon pattern template" $ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: % ", "--", "--load-icon-pattern", ""] cpuArgs <- getArguments args @@ -38,4 +52,5 @@ do let args = ["-L","3","-H","50","--normal","green","--high","red", "-t", "Cpu: "] cpuArgs <- getArguments args cpuValue <- runCpu cpuArgs - cpuValue `shouldSatisfy` (\item -> "Cpu:" `isPrefixOf` cpuValue) + cpuValue `shouldSatisfy` (=~ withFcDigits "Cpu:( " ")+") + diff --git a/xmobar.cabal b/xmobar.cabal --- a/xmobar.cabal +++ b/xmobar.cabal @@ -1,5 +1,5 @@ name: xmobar -version: 0.50 +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,10 +26,11 @@ etc/xmobar.hs, etc/xmonadpropwrite.hs, etc/xmobar.el + etc/notify-once.sh source-repository head type: git - location: git://codeberg.org/xmobar/xmobar.git + location: https://codeberg.org/xmobar/xmobar.git branch: master flag with_xrender @@ -150,7 +151,6 @@ Xmobar.X11.Text, Xmobar.X11.Types, Xmobar.X11.Window, - Xmobar.Plugins.ArchUpdates, Xmobar.Plugins.Command, Xmobar.Plugins.BufferedPipeReader, Xmobar.Plugins.CommandReader, @@ -201,14 +201,13 @@ build-depends: aeson >= 1.4.7.1, async, - base >= 4.11.0 && < 4.21, + base >= 4.18.0 && < 4.22, bytestring >= 0.10.8.2, cairo >= 0.13, colour >= 2.3.6, containers, directory, extra, - extensible-exceptions == 0.1.*, filepath, mtl >= 2.1 && < 2.4, old-locale, @@ -222,6 +221,7 @@ transformers, unix, utf8-string >= 0.3 && < 1.1, + vector, X11 >= 1.6.1 if impl(ghc < 8.0.2) @@ -387,6 +387,7 @@ parsec-numbers, process, regex-compat, + regex-tdfa, stm, temporary, time,