diff options
Diffstat (limited to 'src/Xmobar')
24 files changed, 306 insertions, 110 deletions
diff --git a/src/Xmobar/App/Compile.hs b/src/Xmobar/App/Compile.hs index 80dbac7..5d1f48d 100644 --- a/src/Xmobar/App/Compile.hs +++ b/src/Xmobar/App/Compile.hs @@ -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 Control.Exception.Extensible (bracket, SomeException(..)) import qualified Control.Exception.Extensible as E import Control.Monad (filterM, when) import Data.List ((\\)) -import Data.Maybe (isJust) import System.FilePath((</>), takeExtension) import System.IO import System.Directory import System.Process import System.Exit -import System.Posix.Process(executeFile, forkProcess, getAnyProcessStatus) +import System.Posix.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 $ \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 @@ -168,24 +163,9 @@ recompile confDir dataDir execName force verb = liftIO $ do #ifdef RTSOPTS ++ ["-rtsopts", "-with-rtsopts", "-V0"] #endif +#ifdef SHARED_LIBRARIES + ++ ["-dynamic"] +#endif ++ ["-o", bin] runGHC bin = runProc "ghc" (opts bin) runScript script bin = runProc script [bin] - --- | Ignore SIGPIPE to avoid termination when a pipe is full, and SIGCHLD to --- avoid zombie processes, and clean up any extant zombie processes. -installSignalHandlers :: MonadIO m => m () -installSignalHandlers = liftIO $ do - installHandler openEndedPipe Ignore Nothing - installHandler sigCHLD Ignore Nothing - (try :: IO a -> IO (Either SomeException a)) - $ fix $ \more -> do - x <- getAnyProcessStatus False False - when (isJust x) more - return () - -uninstallSignalHandlers :: MonadIO m => m () -uninstallSignalHandlers = liftIO $ do - installHandler openEndedPipe Default Nothing - installHandler sigCHLD Default Nothing - return () diff --git a/src/Xmobar/App/Opts.hs b/src/Xmobar/App/Opts.hs index 7e42374..0c3fee8 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 Jose Antonio Ortega Ruiz +-- Copyright: (c) 2018, 2019, 2020, 2022, 2023, 2024, 2025 Jose Antonio Ortega Ruiz -- License: BSD3-style (see LICENSE) -- -- Maintainer: jao@gnu.org @@ -116,7 +116,7 @@ usage = usageInfo header options ++ footer info :: String info = "xmobar " ++ showVersion version - ++ "\n (C) 2010 - 2023 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..6377928 --- /dev/null +++ b/src/Xmobar/Plugins/Accordion.hs @@ -0,0 +1,97 @@ +{-# LANGUAGE TupleSections, FlexibleContexts #-} + +----------------------------------------------------------------------------- +-- | +-- 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, Tuning(..)) where + +import Control.Concurrent.Async (withAsync) +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 Data.IORef (atomicModifyIORef', newIORef, readIORef) +import Data.Maybe (isJust) +import System.Directory (removeFile) +import System.Exit (ExitCode(..)) +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] +} deriving (Show, Read) + +makeAccordion :: Exec a => Tuning -> [a] -> Accordion a +makeAccordion t rs = Accordion { tuning = t, plugins = 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, Read a, Show a) => Exec (Accordion a) where + alias (Accordion Tuning { alias' = name } _) = name + start (Accordion Tuning { initial = initial' + , expand = expand' + , shrink = shrink' } + runnables) + cb = do + clicked <- newIORef Nothing + (_, 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 + srefs <- mapM (newIORef . const "") runnables + foldr (\(runnable, sref) acc -> withAsync (start runnable (writeToRef sref)) (const acc)) + (forever (do liftIO (tenthSeconds 1) + clicked' <- liftIO $ readIORef clicked + when (isJust clicked') + (do liftIO $ clear clicked + modify' not) + b <- get + if b then loop pipe else liftIO $ cb (click pipe expand')) + `runReaderT` srefs `evalStateT` initial') + (zip runnables srefs)) + `finally` removeFile pipe + where + click file icon = "<action=`echo 1 > " ++ file ++ "`>" ++ icon ++ "</action>" + clear = (`atomicModifyIORef'` const (Nothing, ())) + removeLinebreak = init + writeToRef strRef = atomicModifyIORef' strRef . const . (,()) + loop p = do + srefs <- ask + text <- join <$> mapM (liftIO . readIORef) srefs + liftIO $ cb $ text ++ click p shrink' diff --git a/src/Xmobar/Plugins/ArchUpdates.hs b/src/Xmobar/Plugins/ArchUpdates.hs new file mode 100644 index 0000000..0dcfd04 --- /dev/null +++ b/src/Xmobar/Plugins/ArchUpdates.hs @@ -0,0 +1,36 @@ +{-# LANGUAGE CPP #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Plugins.Monitors.ArchUpdates +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 + +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 = " <fc=#ff0000>(<action=`xdg-open https://codeberg.org/xmobar/xmobar/pulls/723`>deprecated plugin, click here</action>)</fc>" + +instance Exec ArchUpdates where + alias = const "arch" + rate = rate . intoPacmanUpdates + run = run . intoPacmanUpdates 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 3262b78..ddb2b8c 100644 --- a/src/Xmobar/Plugins/Monitors/Batt/Common.hs +++ b/src/Xmobar/Plugins/Monitors/Batt/Common.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Batt.Common --- Copyright : (c) 2010, 2011, 2012, 2013, 2015, 2016, 2018, 2019 Jose A Ortega +-- Copyright : (c) 2010-2016, 2018, 2019, 2024 Jose A Ortega -- (c) 2010 Andrea Rossato, Petr Rockai -- License : BSD-style (see LICENSE) -- @@ -18,7 +18,7 @@ module Xmobar.Plugins.Monitors.Batt.Common (BattOpts(..) , Status(..) , maybeAlert) where -import System.Process (system) +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 $ system 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/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/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..1e8a8fc --- /dev/null +++ b/src/Xmobar/Plugins/PacmanUpdates.hs @@ -0,0 +1,43 @@ +{-# LANGUAGE CPP #-} + +----------------------------------------------------------------------------- + +----------------------------------------------------------------------------- + +{- | +Module : Plugins.Monitors.PacmanUpdates +Copyright : (c) 2024 Enrico Maria De Angelis + , (c) 2025 Alexander Pankoff +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 +-} +module Xmobar.Plugins.PacmanUpdates (PacmanUpdates (..)) where + +import System.Exit (ExitCode (..)) +import System.Process (readProcessWithExitCode) +import Xmobar.Plugins.Command (Rate) +import Xmobar.Run.Exec + +data PacmanUpdates = PacmanUpdates (String, String, String, String) Rate + deriving (Read, Show) + +instance Exec PacmanUpdates 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" diff --git a/src/Xmobar/Run/Actions.hs b/src/Xmobar/Run/Actions.hs index 2a49312..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 (system) +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 $ system (s ++ "&") +runAction (Spawn _ s) = void $ spawnCommand (s ++ " &") >>= waitForProcess -- | Run action with stdout redirected to stderr runAction' :: Action -> IO () -runAction' (Spawn _ s) = void $ system (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/Template.hs b/src/Xmobar/Run/Template.hs index 87c84d3..68feacb 100644 --- a/src/Xmobar/Run/Template.hs +++ b/src/Xmobar/Run/Template.hs @@ -77,5 +77,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..bb573c8 100644 --- a/src/Xmobar/Run/Types.hs +++ b/src/Xmobar/Run/Types.hs @@ -19,6 +19,7 @@ module Xmobar.Run.Types(runnableTypes) where import {-# SOURCE #-} Xmobar.Run.Runnable() +import Xmobar.Plugins.ArchUpdates import Xmobar.Plugins.Command import Xmobar.Plugins.Monitors import Xmobar.Plugins.Date @@ -59,6 +60,7 @@ infixr :*: runnableTypes :: Command :*: Monitors :*: Date :*: PipeReader :*: BufferedPipeReader :*: CommandReader :*: StdinReader :*: XMonadLog :*: EWMH :*: Kbd :*: Locks :*: NotmuchMail :*: + ArchUpdates :*: #ifdef INOTIFY Mail :*: MBox :*: #endif 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 |