diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Xmobar.hs | 7 | ||||
| -rw-r--r-- | src/Xmobar/App/Compile.hs | 4 | ||||
| -rw-r--r-- | src/Xmobar/App/Opts.hs | 4 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Accordion.hs | 65 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/ArchUpdates.hs | 53 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/MarqueePipeReader.hs | 2 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc | 2 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/MPD.hs | 5 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Mpris.hs | 10 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc | 5 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Monitors/Top.hs | 6 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/PacmanUpdates.hs | 43 | ||||
| -rw-r--r-- | src/Xmobar/Run/Loop.hs | 2 | ||||
| -rw-r--r-- | src/Xmobar/Run/Template.hs | 21 | ||||
| -rw-r--r-- | src/Xmobar/X11/Loop.hs | 6 |
15 files changed, 144 insertions, 91 deletions
diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 5aa748a..a6f86eb 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Xmobar --- Copyright : (c) 2011, 2012, 2013, 2014, 2015, 2017, 2018, 2019, 2022 Jose Antonio Ortega Ruiz +-- Copyright : (c) 2011-2015, 2017-2019, 2022, 2025 Jose Antonio Ortega Ruiz -- (c) 2007 Andrea Rossato -- License : BSD-style (see LICENSE) -- @@ -19,11 +19,10 @@ module Xmobar (xmobar , xmobarMain , defaultConfig , configFromArgs - , tenthSeconds , Runnable (..) - , Exec (..) , Command (..) , SignalType (..) + , module Xmobar.Run.Exec , module Xmobar.Config.Types , module Xmobar.Config.Parse , module Xmobar.Plugins.Accordion @@ -45,6 +44,7 @@ module Xmobar (xmobar #endif , module Xmobar.Plugins.NotmuchMail , module Xmobar.Plugins.Monitors + , module Xmobar.Plugins.PacmanUpdates , module Xmobar.Plugins.PipeReader , module Xmobar.Plugins.MarqueePipeReader , module Xmobar.Plugins.StdinReader @@ -74,6 +74,7 @@ import Xmobar.Plugins.Mail import Xmobar.Plugins.MBox #endif import Xmobar.Plugins.Monitors +import Xmobar.Plugins.PacmanUpdates import Xmobar.Plugins.PipeReader import Xmobar.Plugins.StdinReader import Xmobar.Plugins.MarqueePipeReader diff --git a/src/Xmobar/App/Compile.hs b/src/Xmobar/App/Compile.hs index 5d1f48d..cee6a8a 100644 --- a/src/Xmobar/App/Compile.hs +++ b/src/Xmobar/App/Compile.hs @@ -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 (bracket, SomeException(..)) +import qualified Control.Exception as E import Control.Monad (filterM, when) import Data.List ((\\)) import System.FilePath((</>), takeExtension) diff --git a/src/Xmobar/App/Opts.hs b/src/Xmobar/App/Opts.hs index 36da745..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, 2024 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 - 2024 Jose A Ortega Ruiz" + ++ "\n (C) 2010 - 2025 Jose A Ortega Ruiz" ++ "\n (C) 2007 - 2010 Andrea Rossato\n " ++ mail ++ "\n" ++ license ++ "\n" diff --git a/src/Xmobar/Plugins/Accordion.hs b/src/Xmobar/Plugins/Accordion.hs index 6377928..6a1d8e8 100644 --- a/src/Xmobar/Plugins/Accordion.hs +++ b/src/Xmobar/Plugins/Accordion.hs @@ -15,7 +15,7 @@ -- ----------------------------------------------------------------------------- -module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, Tuning(..)) where +module Xmobar.Plugins.Accordion (defaultTuning, makeAccordion, makeAccordion', Tuning(..)) where import Control.Concurrent.Async (withAsync) import Control.Exception (finally) @@ -23,10 +23,11 @@ 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.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) @@ -38,10 +39,14 @@ import Xmobar.Run.Exec (Exec(..), tenthSeconds) data Accordion a = Accordion { tuning :: Tuning , plugins :: [a] + , shortPlugins :: [a] } deriving (Show, Read) makeAccordion :: Exec a => Tuning -> [a] -> Accordion a -makeAccordion t rs = Accordion { tuning = t, plugins = rs } +makeAccordion t rs = Accordion { tuning = t, plugins = rs, shortPlugins = [] } + +makeAccordion' :: Exec a => Tuning -> [a] -> [a] -> Accordion a +makeAccordion' t rs rs' = Accordion { tuning = t, plugins = rs, shortPlugins = rs' } data Tuning = Tuning { alias' :: String @@ -59,39 +64,49 @@ defaultTuning = Tuning { } instance (Exec a, Read a, Show a) => Exec (Accordion a) where - alias (Accordion Tuning { alias' = name } _) = name + alias (Accordion Tuning { alias' = name } _ _) = name start (Accordion Tuning { initial = initial' - , expand = expand' - , shrink = shrink' } - runnables) + , expand = expandIcon + , shrink = shrinkIcon } + runnables + shortRunnables) 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?") + withAsync (forever $ do "" <- withFileBlocking pipe ReadMode hGetContents' + atomicModifyIORef' clicked (const (Just (), ()))) (const $ do - srefs <- mapM (newIORef . const "") runnables - foldr (\(runnable, sref) acc -> withAsync (start runnable (writeToRef sref)) (const acc)) + 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 - if b then loop pipe else liftIO $ cb (click pipe expand')) - `runReaderT` srefs `evalStateT` initial') - (zip runnables srefs)) + loop b pipe) + `runReaderT` (strRefs, strRefs') + `evalStateT` initial') + (zip (runnables ++ shortRunnables) + (strRefs ++ strRefs'))) `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' + loop b p = 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) + +writeToRef :: IORef a -> a -> IO () +writeToRef strRef = atomicModifyIORef' strRef . const . (,()) + +clear :: IORef (Maybe a) -> IO () +clear = (`atomicModifyIORef'` const (Nothing, ())) + +removeLinebreak :: [a] -> [a] +removeLinebreak = init + +attachClick :: String -> String -> String +attachClick file icon = "<action=`echo -n > " ++ file ++ "`>" ++ icon ++ "</action>" diff --git a/src/Xmobar/Plugins/ArchUpdates.hs b/src/Xmobar/Plugins/ArchUpdates.hs index f803d0f..0dcfd04 100644 --- a/src/Xmobar/Plugins/ArchUpdates.hs +++ b/src/Xmobar/Plugins/ArchUpdates.hs @@ -1,41 +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 +{- | +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) +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 (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" + alias = const "arch" + rate = rate . intoPacmanUpdates + run = run . intoPacmanUpdates 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/Disk/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc index 296ba6c..b5530f1 100644 --- a/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc +++ b/src/Xmobar/Plugins/Monitors/Disk/FreeBSD.hsc @@ -39,7 +39,7 @@ import Xmobar.Plugins.Monitors.Disk.Common ( , Path ) -import qualified Control.Exception.Extensible as E +import qualified Control.Exception as E import qualified Data.List as DL import qualified Data.Map as DM import qualified Data.Set as DS diff --git a/src/Xmobar/Plugins/Monitors/MPD.hs b/src/Xmobar/Plugins/Monitors/MPD.hs index 7ecbc0c..b091147 100644 --- a/src/Xmobar/Plugins/Monitors/MPD.hs +++ b/src/Xmobar/Plugins/Monitors/MPD.hs @@ -109,8 +109,9 @@ parseMPD (Right st) song opts = do si = stateGlyph s opts vol = int2str $ fromMaybe 0 (M.stVolume st) (p, t) = fromMaybe (0, 0) (M.stTime st) - [lap, len, remain] = map showTime - [floor p, floor t, max 0 (floor t - floor p)] + lap = showTime $ floor p + len = showTime $ floor t + remain = showTime $ max 0 (floor t - floor p) b = if t > 0 then realToFrac $ p / t else 0 plen = int2str $ M.stPlaylistLength st ppos = maybe "" (int2str . (+1)) $ M.stSongPos st diff --git a/src/Xmobar/Plugins/Monitors/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/Swap/FreeBSD.hsc b/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc index 9c74e36..90c58c1 100644 --- a/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc +++ b/src/Xmobar/Plugins/Monitors/Swap/FreeBSD.hsc @@ -71,11 +71,10 @@ instance Storable SwapData where poke _ _ = pure () - isEnabled :: IO Bool isEnabled = do - enabled <- sysctlReadUInt "vm.swap_enabled" - return $ enabled == 1 + nswapdev <- sysctlReadUInt "vm.nswapdev" + return $ nswapdev > 0 parseMEM' :: Bool -> IO [Float] parseMEM' False = return [] diff --git a/src/Xmobar/Plugins/Monitors/Top.hs b/src/Xmobar/Plugins/Monitors/Top.hs index 3bfe6fd..b2e573b 100644 --- a/src/Xmobar/Plugins/Monitors/Top.hs +++ b/src/Xmobar/Plugins/Monitors/Top.hs @@ -3,7 +3,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Plugins.Monitors.Top --- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018, 2022 Jose A Ortega Ruiz +-- Copyright : (c) 2010-2014, 2018, 2022, 2025 Jose A Ortega Ruiz -- License : BSD-style (see LICENSE) -- -- Maintainer : Jose A Ortega Ruiz <jao@gnu.org> @@ -20,7 +20,7 @@ import Xmobar.Plugins.Monitors.Common import Data.IORef (newIORef, readIORef, writeIORef) import Data.List (sortBy) -import Data.Ord (comparing) +import Data.Ord (comparing, Down (..)) import Data.Time.Clock (getCurrentTime, diffUTCTime) import Xmobar.Plugins.Monitors.Top.Common ( @@ -66,7 +66,7 @@ showInfo nm sms mms = do sortTop :: [(String, Float)] -> [(String, Float)] -sortTop = sortBy (flip (comparing snd)) +sortTop = sortBy (comparing (Down . snd)) showMemInfo :: Float -> MemInfo -> Monitor [String] showMemInfo scale (nm, rss) = diff --git a/src/Xmobar/Plugins/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/Loop.hs b/src/Xmobar/Run/Loop.hs index bda41ff..6775961 100644 --- a/src/Xmobar/Run/Loop.hs +++ b/src/Xmobar/Run/Loop.hs @@ -57,7 +57,7 @@ type LoopFunction = TMVar SignalType -> TVar [String] -> IO () loop :: Config -> LoopFunction -> IO () loop conf looper = withDeferSignals $ do - cls <- mapM (parseTemplate (commands conf) (sepChar conf)) + let cls = map (parseTemplate (commands conf) (sepChar conf)) (splitTemplate (alignSep conf) (template conf)) let confSig = unSignalChan (signal conf) sig <- maybe newEmptyTMVarIO pure confSig diff --git a/src/Xmobar/Run/Template.hs b/src/Xmobar/Run/Template.hs index 68feacb..0e066dc 100644 --- a/src/Xmobar/Run/Template.hs +++ b/src/Xmobar/Run/Template.hs @@ -50,21 +50,20 @@ templateParser s = many $ templateStringParser s -- | Actually runs the template parsers over a (segment of) a template -- string, returning a list of runnables with their prefix and suffix. -parseTemplate :: [Runnable] -> String -> String -> IO [(Runnable,String,String)] +parseTemplate :: [Runnable] -> String -> String -> [(Runnable,String,String)] parseTemplate c sepChar s = - do str <- case parse (templateParser sepChar) "" s of - Left _ -> return [("", s, "")] - Right x -> return x - let cl = map alias c - m = Map.fromList $ zip cl c - return $ combine c m str + let str = case parse (templateParser sepChar) "" s of + Left _ -> [("", s, "")] + Right x -> x + cl = map alias c + m = Map.fromList $ zip cl c + in combine m str -- | Given a finite "Map" and a parsed template produce the resulting -- output string. -combine :: [Runnable] -> Map.Map String Runnable -> [(String, String, String)] - -> [(Runnable,String,String)] -combine _ _ [] = [] -combine c m ((ts,s,ss):xs) = (com, s, ss) : combine c m xs +combine :: Map.Map String Runnable -> [(String, String, String)] -> [(Runnable,String,String)] +combine _ [] = [] +combine m ((ts,s,ss):xs) = (com, s, ss) : combine m xs where com = Map.findWithDefault dflt ts m dflt = Run $ Com ts [] [] 10 diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs index 2dfb34d..0425cff 100644 --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -170,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 |
