From de7a0aff77114638f3e83835de0fe00395fe6bf7 Mon Sep 17 00:00:00 2001 From: jao Date: Wed, 12 Feb 2025 02:06:55 +0000 Subject: on-click implementation based on implicit actions Draw methods based on Segments don't keep enough information to fill in correctly a list of actions. With this implementation, we introduce empty actions as markers where Runnable instances can be inserted. Triggering them is then just calling the corresponding Exec method, onClick. Conceivably, onClick could receive some kind of additional state, but that's better done as a base Plugin instance that keeps state and makes it available via its onClick function, for instance. Very lightly tested, needs documentation and extending the plugin example to include an onClick method. --- src/Xmobar/Config/Template.hs | 9 ++++++--- src/Xmobar/Run/Actions.hs | 6 ++++++ src/Xmobar/Run/Loop.hs | 6 ++++-- src/Xmobar/X11/Loop.hs | 36 ++++++++++++++++++------------------ 4 files changed, 34 insertions(+), 23 deletions(-) (limited to 'src') diff --git a/src/Xmobar/Config/Template.hs b/src/Xmobar/Config/Template.hs index ad30c3d..6ea1898 100644 --- a/src/Xmobar/Config/Template.hs +++ b/src/Xmobar/Config/Template.hs @@ -1,7 +1,7 @@ ------------------------------------------------------------------------------ -- | -- Module: Xmobar.Config.Template --- Copyright: (c) 2022 jao +-- Copyright: (c) 2022, 2025 jao -- License: BSD3-style (see LICENSE) -- -- Maintainer: mail@jao.io @@ -15,7 +15,7 @@ ------------------------------------------------------------------------------ -module Xmobar.Config.Template (parseString) where +module Xmobar.Config.Template (parseString, withEmptyAction) where import Data.Maybe (fromMaybe) import qualified Control.Monad as CM @@ -101,11 +101,14 @@ hspaceParser c = do pVal <- C.manyTill P.digit (P.try (P.string "/>")) retSegment c (T.Hspace (fromMaybe 0 $ readMaybe pVal)) +withEmptyAction :: String -> String +withEmptyAction str = "" ++ str ++ "" + actionParser :: Context -> Parser [T.Segment] actionParser (ti, fi, act) = do P.string " C.many1 (P.noneOf ">") + <|> C.many1 (P.noneOf ">") <|> P.string "" buttons <- (P.char '>' >> return "1") <|> (P.space >> P.spaces >> C.between (P.string "button=") (P.string ">") (C.many1 (P.oneOf "12345"))) let a = T.Spawn (toButtons buttons) command diff --git a/src/Xmobar/Run/Actions.hs b/src/Xmobar/Run/Actions.hs index cbc10c5..fc9682d 100644 --- a/src/Xmobar/Run/Actions.hs +++ b/src/Xmobar/Run/Actions.hs @@ -12,6 +12,7 @@ module Xmobar.Run.Actions ( Button , Action(..) + , isEmpty , runAction , runAction' , stripActions) where @@ -20,12 +21,17 @@ import System.Process (spawnCommand, waitForProcess) import Control.Monad (void) import Text.Regex (Regex, subRegex, mkRegex, matchRegex) import Data.Word (Word32) +import Data.Char (isSpace) type Button = Word32 data Action = Spawn [Button] String deriving (Eq, Read, Show) +isEmpty :: Action -> Bool +isEmpty (Spawn _ s) = all isSpace s + runAction :: Action -> IO () +runAction a | isEmpty a = return () runAction (Spawn _ s) = void $ spawnCommand (s ++ " &") >>= waitForProcess -- | Run action with stdout redirected to stderr diff --git a/src/Xmobar/Run/Loop.hs b/src/Xmobar/Run/Loop.hs index 9954cb9..343a857 100644 --- a/src/Xmobar/Run/Loop.hs +++ b/src/Xmobar/Run/Loop.hs @@ -28,6 +28,7 @@ import Data.Foldable (for_) import Xmobar.System.Signal import Xmobar.Config.Types +import Xmobar.Config.Template (withEmptyAction) import Xmobar.Run.Runnable (Runnable) import Xmobar.Run.Exec (start, trigger, alias) import Xmobar.Run.Template @@ -94,14 +95,15 @@ initLoop sig lock vs = do -- | Runs a command as an independent thread and returns its Async handles -- and the TVar the command will be writing to. startCommand :: TMVar SignalType - -> (Runnable,String,String) + -> (Runnable, String, String) -> IO ([Async ()], TVar String) startCommand sig (com,s,ss) | alias com == "" = do var <- newTVarIO is atomically $ writeTVar var (s ++ ss) return ([], var) | otherwise = do var <- newTVarIO is - let cb str = atomically $ writeTVar var (s ++ str ++ ss) + let cb str = atomically $ + writeTVar var (s ++ withEmptyAction str ++ ss) a1 <- async $ start com cb a2 <- async $ trigger com $ maybe (return ()) (atomically . putTMVar sig) diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs index 0451697..5f0a762 100644 --- a/src/Xmobar/X11/Loop.hs +++ b/src/Xmobar/X11/Loop.hs @@ -58,8 +58,9 @@ import qualified Xmobar.X11.Window as W import qualified Xmobar.X11.Events as E #endif -data Act = Run R.Runnable | Act [A.Action] -type Acts = [(Act, D.Position, D.Position)] +data Act = Run R.Runnable | Act [A.Action] deriving Show +type ActPos = (Act, D.Position, D.Position) +type Acts = [ActPos] runX :: T.XConf -> T.X a -> IO a runX xc f = MR.runReaderT f xc @@ -108,13 +109,6 @@ eventLoop dpy w signalv = where (b, p) = (X11x.ev_button ev, fromIntegral $ X11x.ev_x ev) _ -> return () -completeActions :: [R.Runnable] -> D.Actions -> Acts -> Acts -completeActions [] _ res = reverse res -completeActions _ [] res = reverse res -completeActions (r:rs) (([], x, y):as) res = - completeActions rs as ((Run r, x, y):res) -completeActions (_:rs) ((a, x, y):as) res = - completeActions rs as ((Act a, x, y):res) -- | Continuously wait for a signal from a thread or an interrupt handler. -- The list of actions provides the positions of clickable rectangles, @@ -124,10 +118,9 @@ signalLoop :: T.XConf -> [R.Runnable] -> D.Actions -> STM.TMVar S.SignalType -> STM.TVar [String] -> IO () signalLoop xc@(T.XConf d r w fs is cfg) runs actions signalv strs = do typ <- STM.atomically $ STM.takeTMVar signalv - let acts = completeActions runs actions [] case typ of S.Wakeup -> wakeup - S.Action button x -> runActs acts button x >> loopOn + S.Action button x -> runActions runs actions button x >> loopOn S.Reposition -> reposWindow cfg S.ChangeScreen -> updateConfigPosition d cfg >>= reposWindow S.Hide t -> hiderev t S.Hide W.hideWindow @@ -185,14 +178,21 @@ updateConfigPosition disp cfg = else (cfg {C.position = C.OnScreen (n+1) o})) o -> return (cfg {C.position = C.OnScreen 1 o}) -runAct :: A.Button -> Act -> IO () -runAct b (Run r) = E.onClick r b -runAct b (Act as) = +toActs :: [R.Runnable] -> D.Actions -> Acts -> Acts +toActs [] _ res = reverse res +toActs _ [] res = reverse res +toActs (r:rs) (([a], x, y):as) res + | A.isEmpty a = toActs rs as ((Run r, x, y):res) +toActs rs ((a, x, y):as) res = toActs rs as ((Act a, x, y):res) + +runAct :: A.Button -> ActPos -> IO () +runAct b ((Run r), _, _) = E.onClick r b +runAct b ((Act as), _, _) = mapM_ A.runAction $ filter (\(A.Spawn bs _) -> b `elem` bs) as -runActs:: Acts -> A.Button -> X11.Position -> IO () -runActs acts button pos = +runActions :: [R.Runnable] -> D.Actions -> A.Button -> X11.Position -> IO () +runActions runs actions button pos = mapM_ (runAct button) $ - map (\(a, _, _) -> a) $ - filter (\(_, from, to) -> pos' >= from && pos' <= to) acts + filter (\(_, from, to) -> pos' >= from && pos' < to) acts where pos' = fromIntegral pos + acts = toActs runs actions [] -- cgit v1.2.3