summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
-rw-r--r--doc/accordion.gifbin0 -> 71898 bytes
-rw-r--r--doc/plugins.org23
-rw-r--r--src/Xmobar.hs2
-rw-r--r--src/Xmobar/Plugins/Accordion.hs97
-rw-r--r--xmobar.cabal1
5 files changed, 123 insertions, 0 deletions
diff --git a/doc/accordion.gif b/doc/accordion.gif
new file mode 100644
index 0000000..c21d2b0
--- /dev/null
+++ b/doc/accordion.gif
Binary files differ
diff --git a/doc/plugins.org b/doc/plugins.org
index 3433df3..7453d4b 100644
--- a/doc/plugins.org
+++ b/doc/plugins.org
@@ -1365,6 +1365,29 @@
"<fc=red>? updates</fc>")
600
#+end_src
+
+*** =makeAccordion Tuning [Runnable]=
+
+ - Wraps other =Runnable= plugins and makes them all collapsible to a single string:
+
+ [[file:accordion.gif]]
+
+ - 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
+ 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,