diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Xmobar.hs | 2 | ||||
-rw-r--r-- | src/Xmobar/App/Compile.hs | 27 | ||||
-rw-r--r-- | src/Xmobar/Draw/Boxes.hs | 11 | ||||
-rw-r--r-- | src/Xmobar/Draw/Cairo.hs | 13 | ||||
-rw-r--r-- | src/Xmobar/Plugins/ArchUpdates.hs | 41 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Kbd.hs | 72 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Locks.hs | 58 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Alsa.hs | 6 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Batt/Common.hs | 4 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Common/Output.hs | 20 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Disk.hs | 8 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Mem/Linux.hs | 10 | ||||
-rw-r--r-- | src/Xmobar/Plugins/Monitors/Net/Linux.hs | 5 | ||||
-rw-r--r-- | src/Xmobar/Run/Actions.hs | 6 | ||||
-rw-r--r-- | src/Xmobar/Run/Template.hs | 3 | ||||
-rw-r--r-- | src/Xmobar/Run/Types.hs | 2 | ||||
-rw-r--r-- | src/Xmobar/System/Environment.hs | 3 | ||||
-rw-r--r-- | src/Xmobar/X11/Bitmap.hs | 7 | ||||
-rw-r--r-- | src/Xmobar/X11/Loop.hs | 5 |
19 files changed, 158 insertions, 145 deletions
diff --git a/src/Xmobar.hs b/src/Xmobar.hs index ced40a5..374825b 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -26,6 +26,7 @@ module Xmobar (xmobar , SignalType (..) , module Xmobar.Config.Types , module Xmobar.Config.Parse + , module Xmobar.Plugins.ArchUpdates , module Xmobar.Plugins.BufferedPipeReader , module Xmobar.Plugins.CommandReader , module Xmobar.Plugins.Date @@ -53,6 +54,7 @@ import Xmobar.Run.Runnable import Xmobar.Run.Exec import Xmobar.Config.Types import Xmobar.Config.Parse +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 index 368c3e6..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 @@ -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/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/ArchUpdates.hs b/src/Xmobar/Plugins/ArchUpdates.hs new file mode 100644 index 0000000..f803d0f --- /dev/null +++ b/src/Xmobar/Plugins/ArchUpdates.hs @@ -0,0 +1,41 @@ +{-# 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 System.Exit (ExitCode(..)) +import System.Process (readProcessWithExitCode) +import Xmobar.Run.Exec +import Xmobar.Plugins.Command (Rate) + +data ArchUpdates = ArchUpdates (String, String, String) Rate + deriving (Read, Show) + +instance Exec ArchUpdates where + alias (ArchUpdates _ _) = "arch" + rate (ArchUpdates _ r) = r + run (ArchUpdates (z, o, m) _) = do + (exit, stdout, _) <- readProcessWithExitCode "checkupdates" [] "" + return $ case exit of + ExitFailure 2 -> z--ero updates + ExitFailure 1 -> "pacman: Unknown cause of failure." + 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/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/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/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/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/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/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..2dfb34d 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 |