diff options
Diffstat (limited to 'src/Xmobar')
| -rw-r--r-- | src/Xmobar/App/Opts.hs | 4 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Accordion.hs | 56 | ||||
| -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/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/X11/Loop.hs | 6 | 
10 files changed, 122 insertions, 68 deletions
| 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..c1967c2 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,7 +23,7 @@ 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 System.Directory (removeFile)  import System.Exit (ExitCode(..)) @@ -38,10 +38,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,11 +63,12 @@ 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" [] "" @@ -74,24 +79,35 @@ instance (Exec a, Read a, Show a) => Exec (Accordion a) where                                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)) +                  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 1 > " ++ 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/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/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 | 
