diff options
| -rw-r--r-- | changelog.md | 2 | ||||
| -rw-r--r-- | doc/accordion.gif | bin | 0 -> 71898 bytes | |||
| -rw-r--r-- | doc/plugins.org | 41 | ||||
| -rw-r--r-- | src/Xmobar.hs | 2 | ||||
| -rw-r--r-- | src/Xmobar/Plugins/Accordion.hs | 97 | ||||
| -rw-r--r-- | xmobar.cabal | 1 |
6 files changed, 131 insertions, 12 deletions
diff --git a/changelog.md b/changelog.md index 20308fd..fe61524 100644 --- a/changelog.md +++ b/changelog.md @@ -1,6 +1,6 @@ ## Version 0.49 (unreleased) -- New plugin: `ArchUpdates` (thanks, Enrico Maria) +- New plugins: `ArchUpdates` and `Accordion` (thanks, Enrico Maria) ## Version 0.48.1 (May, 2024) diff --git a/doc/accordion.gif b/doc/accordion.gif Binary files differnew file mode 100644 index 0000000..c21d2b0 --- /dev/null +++ b/doc/accordion.gif diff --git a/doc/plugins.org b/doc/plugins.org index e5bf42a..7453d4b 100644 --- a/doc/plugins.org +++ b/doc/plugins.org @@ -1351,24 +1351,43 @@ the display of those numeric fields. - Default template: =Up: <days>d <hours>h <minutes>m= -*** =ArchUpdates' (Zero, One, Many) Rate= +*** =ArchUpdates (Zero, One, Many) Rate= + - Aliases to =arch= + - =Zero=: a =String= to use when the system is up to date. + - =One=: a =String= to use when only one update is available. + - =Many=: a =String= to use when several updates are available; it must contain + a =?= character as a placeholder for the number of updates. + - Example: + #+begin_src haskell + ArchUpdates ("<fc=green>up to date</fc>", + "<fc=yellow>1 update</fc>, + "<fc=red>? updates</fc>") + 600 + #+end_src - - =Zero=: a =String= for when the system is up to date. +*** =makeAccordion Tuning [Runnable]= - - =One=: a =String= for when only one update is available. + - Wraps other =Runnable= plugins and makes them all collapsible to a single string: - - =Many=: a =String= for when several updates are available; it must contain a =?= - character as a placeholder for the number of updates. + [[file:accordion.gif]] - - Example: - In a plain configuration file: + - Aliases to =alias' tuning=, being =tuning= of type =Tuning=, so one can use multiple such "accordions" + - **Disclaimer**: This only works for Haskell =xmobar.hs= + - =Tuning=: the "settings", for which a default value is provided, #+begin_src haskell - ArchUpdates' ("<fc=green>up to date</fc>", - "<fc=yellow>1 update</fc>, - "<fc=red>? updates</fc>") - 600 + defaultTuning = Tuning { + alias' = "accordion" + , initial = True + , expand = "<>" + , shrink = "><" + } #+end_src + - =expand=: =String= shown when the accordion is contracted (defaults to ="<>"=). + - =shrink=: =String= shown when the accordion is expanded (defaults to ="><"=). + - =initial=: =Bool= to tell whether the accordion is initially expanded (defaults to =True=). + - =[Runnable]=: a list of =Runnable= plugins + * Interfacing with window managers :PROPERTIES: :CUSTOM_ID: interfacing-with-window-managers diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 374825b..5aa748a 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.Accordion , module Xmobar.Plugins.ArchUpdates , module Xmobar.Plugins.BufferedPipeReader , module Xmobar.Plugins.CommandReader @@ -54,6 +55,7 @@ import Xmobar.Run.Runnable import Xmobar.Run.Exec import Xmobar.Config.Types import Xmobar.Config.Parse +import Xmobar.Plugins.Accordion import Xmobar.Plugins.ArchUpdates import Xmobar.Plugins.Command import Xmobar.Plugins.BufferedPipeReader 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/xmobar.cabal b/xmobar.cabal index 8a31619..0b548b1 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -105,6 +105,7 @@ library hs-source-dirs: src exposed-modules: Xmobar, + Xmobar.Plugins.Accordion, Xmobar.Plugins.Monitors.Common.Types, Xmobar.Plugins.Monitors.Common.Run, Xmobar.Plugins.Monitors.Common, |
