prototype for onClick method in Exec

6 files changed, 55 insertions, 26 deletions

diff --git a/src/Xmobar/Draw/Cairo.hs b/src/Xmobar/Draw/Cairo.hs
index 2338b10..fcedb32 100644
--- a/src/Xmobar/Draw/Cairo.hs
+++ b/src/Xmobar/Draw/Cairo.hs
@@ -2,7 +2,7 @@
 ------------------------------------------------------------------------------
 -- |
 -- Module: Xmobar.X11.Cairo
--- Copyright: (c) 2022, 2023, 2024 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2022, 2023, 2024, 2025 Jose Antonio Ortega Ruiz
 -- License: BSD3-style (see LICENSE)
 --
 -- Maintainer: jao@gnu.org
@@ -124,7 +124,9 @@ drawSegment :: T.DrawContext -> Surface -> Double -> Acc -> Renderinfo -> IO Acc
 drawSegment dctx surface maxoff (off, acts, boxs) (segment, render, lwidth) = do
   let end = min maxoff (off + lwidth)
       (_, info, _, a) = segment
-      acts' = case a of Just as -> (as, off, end):acts; _ -> acts
+      acts' = case a of
+                Just as -> (as, off, end):acts
+                _ -> ([], off, end):acts
       bs = C.tBoxes info
       boxs' = if null bs then boxs else (off, end, bs):boxs
   when (end > off) $ do
diff --git a/src/Xmobar/Run/Exec.hs b/src/Xmobar/Run/Exec.hs
index 1879361..e5c5c8c 100644
--- a/src/Xmobar/Run/Exec.hs
+++ b/src/Xmobar/Run/Exec.hs
@@ -21,6 +21,7 @@ module Xmobar.Run.Exec (Exec (..), tenthSeconds, doEveryTenthSeconds) where
 
 import Prelude
 import Data.Char
+import Data.Word (Word32)
 
 import Xmobar.Run.Timer (doEveryTenthSeconds, tenthSeconds)
 import Xmobar.System.Signal
@@ -37,3 +38,5 @@ class Show e => Exec e where
         where go = doEveryTenthSeconds (rate e) $ run e >>= cb
     trigger :: e -> (Maybe SignalType -> IO ()) -> IO ()
     trigger _ sh  = sh Nothing
+    onClick :: e -> Word32 -> IO ()
+    onClick _ _ = return ()
diff --git a/src/Xmobar/Run/Loop.hs b/src/Xmobar/Run/Loop.hs
index bda41ff..3e2aa16 100644
--- a/src/Xmobar/Run/Loop.hs
+++ b/src/Xmobar/Run/Loop.hs
@@ -3,7 +3,7 @@
 ------------------------------------------------------------------------------
 -- |
 -- Module: Xmobar.Run.Loop
--- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2022, 2025 Jose Antonio Ortega Ruiz
 -- License: BSD3-style (see LICENSE)
 --
 -- Maintainer: jao@gnu.org
@@ -53,12 +53,12 @@ refreshLockT var action = do
     putTMVar var ()
     return r
 
-type LoopFunction = TMVar SignalType -> TVar [String] -> IO ()
+type LoopFunction = [Runnable] -> TMVar SignalType -> TVar [String] -> IO ()
 
 loop :: Config -> LoopFunction -> IO ()
 loop conf looper = withDeferSignals $ do
   cls <- mapM (parseTemplate (commands conf) (sepChar conf))
-                (splitTemplate (alignSep conf) (template conf))
+              (splitTemplate (alignSep conf) (template conf))
   let confSig = unSignalChan (signal conf)
   sig <- maybe newEmptyTMVarIO pure confSig
   unless (isJust confSig) $ setupSignalHandler sig
@@ -68,7 +68,7 @@ loop conf looper = withDeferSignals $ do
             cleanupThreads
             $ \vars -> do
       tv <- initLoop sig refLock vars
-      looper sig tv
+      looper (commands conf) sig tv
 
 cleanupThreads :: [[([Async ()], a)]] -> IO ()
 cleanupThreads vars =
diff --git a/src/Xmobar/Run/Runnable.hs b/src/Xmobar/Run/Runnable.hs
index f89f901..a95e70b 100644
--- a/src/Xmobar/Run/Runnable.hs
+++ b/src/Xmobar/Run/Runnable.hs
@@ -32,6 +32,7 @@ instance Exec Runnable where
      start   (Run a) = start   a
      alias   (Run a) = alias   a
      trigger (Run a) = trigger a
+     onClick (Run a) = onClick a
 
 instance Show Runnable where
     show (Run x) = "Run " ++ show x
diff --git a/src/Xmobar/Text/Loop.hs b/src/Xmobar/Text/Loop.hs
index 5d2c43f..62dd5c8 100644
--- a/src/Xmobar/Text/Loop.hs
+++ b/src/Xmobar/Text/Loop.hs
@@ -1,7 +1,7 @@
 ------------------------------------------------------------------------------
 -- |
 -- Module: Xmobar.Text.Loop
--- Copyright: (c) 2022 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2022, 2025 Jose Antonio Ortega Ruiz
 -- License: BSD3-style (see LICENSE)
 --
 -- Maintainer: jao@gnu.org
@@ -24,6 +24,7 @@ import Control.Concurrent.STM
 import Xmobar.System.Signal
 import Xmobar.Config.Types (Config)
 import Xmobar.Run.Loop (loop)
+import Xmobar.Run.Runnable (Runnable)
 import Xmobar.Text.Output (initLoop, format)
 
 -- | Starts the main event loop and threads
@@ -35,12 +36,12 @@ textLoop conf = do
   loop conf (eventLoop conf)
 
 -- | Continuously wait for a signal from a thread or a interrupt handler
-eventLoop :: Config -> TMVar SignalType -> TVar [String] -> IO ()
-eventLoop cfg signal tv = do
+eventLoop :: Config -> [Runnable] -> TMVar SignalType -> TVar [String] -> IO ()
+eventLoop cfg rs signal tv = do
   typ <- atomically $ takeTMVar signal
   case typ of
-    Wakeup -> updateString cfg tv >>= putStrLn >> eventLoop cfg signal tv
-    _ -> eventLoop cfg signal tv
+    Wakeup -> updateString cfg tv >>= putStrLn >> eventLoop cfg rs signal tv
+    _ -> eventLoop cfg rs signal tv
 
 updateString :: Config -> TVar [String] -> IO String
 updateString conf v = do
diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs
index 2dfb34d..1da1631 100644
--- a/src/Xmobar/X11/Loop.hs
+++ b/src/Xmobar/X11/Loop.hs
@@ -3,7 +3,7 @@
 ------------------------------------------------------------------------------
 -- |
 -- Module: Xmobar.App.X11EventLoop
--- Copyright: (c) 2018, 2020, 2022, 2023, 2024 Jose Antonio Ortega Ruiz
+-- Copyright: (c) 2018, 2020, 2022, 2023, 2024, 2025 Jose Antonio Ortega Ruiz
 -- License: BSD3-style (see LICENSE)
 --
 -- Maintainer: jao@gnu.org
@@ -40,6 +40,8 @@ import qualified Xmobar.Config.Template as CT
 
 import qualified Xmobar.Run.Actions as A
 import qualified Xmobar.Run.Loop as L
+import qualified Xmobar.Run.Exec as E
+import qualified Xmobar.Run.Runnable as R
 
 import qualified Xmobar.System.Utils as U
 import qualified Xmobar.System.Signal as S
@@ -56,6 +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)]
+
 runX :: T.XConf -> T.X a -> IO a
 runX xc f = MR.runReaderT f xc
 
@@ -69,10 +74,14 @@ x11Loop conf = do
   (r,w) <- W.createWin d fs conf
   L.loop conf (startLoop (T.XConf d r w (fs :| fl) Map.empty conf))
 
-startLoop :: T.XConf -> STM.TMVar S.SignalType -> STM.TVar [String] -> IO ()
-startLoop xcfg sig tv = do
+startLoop :: T.XConf
+             -> [R.Runnable]
+             -> STM.TMVar S.SignalType
+             -> STM.TVar [String]
+             -> IO ()
+startLoop xcfg runns sig tv = do
   U.forkThread "X event handler" (eventLoop (T.display xcfg) (T.window xcfg) sig)
-  signalLoop xcfg [] sig tv
+  signalLoop xcfg runns [] sig tv
 
 -- | Translates X11 events received by w to signals handled by signalLoop
 eventLoop :: X11.Display -> X11.Window -> STM.TMVar S.SignalType -> IO ()
@@ -99,17 +108,26 @@ 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 = res
+completeActions _ [] res = 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,
 -- and there is a mutable variable for received signals and the list
 -- of strings updated by running monitors.
-signalLoop ::
-  T.XConf -> D.Actions -> STM.TMVar S.SignalType -> STM.TVar [String] -> IO ()
-signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do
+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  -> runActions actions button x >> loopOn
+      S.Action button x  -> runActions acts button x >> loopOn
       S.Reposition       -> reposWindow cfg
       S.ChangeScreen     -> updateConfigPosition d cfg >>= reposWindow
       S.Hide t           -> hiderev t S.Hide W.hideWindow
@@ -118,7 +136,7 @@ signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do
       S.TogglePersistent -> updateCfg $ cfg {C.persistent = not $ C.persistent cfg}
       S.SetAlpha a       -> updateCfg $ cfg {C.alpha = a}
     where
-        loopOn' xc' = signalLoop xc' actions signalv strs
+        loopOn' xc' = signalLoop xc' runs actions signalv strs
         loopOn = loopOn' xc
         updateCfg cfg' = loopOn' (xc {T.config = cfg'})
 
@@ -126,7 +144,7 @@ signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do
           segs <- parseSegments cfg strs
           xc' <- updateIconCache xc segs
           actions' <- runX xc' (Draw.draw segs)
-          signalLoop xc' actions' signalv strs
+          signalLoop xc' runs actions' signalv strs
 
         hiderev t sign op
             | t == 0 = MR.unless (C.persistent cfg) (op d w) >> loopOn
@@ -144,7 +162,7 @@ signalLoop xc@(T.XConf d r w fs is cfg) actions signalv strs = do
 
         reposWindow rcfg = do
           r' <- W.repositionWin d w (NE.head fs) rcfg
-          signalLoop (T.XConf d r' w fs is rcfg) actions signalv strs
+          signalLoop (T.XConf d r' w fs is rcfg) runs actions signalv strs
 
 parseSegments :: C.Config -> STM.TVar [String] -> IO [[C.Segment]]
 parseSegments conf v = do
@@ -167,10 +185,14 @@ updateConfigPosition disp cfg =
               else (cfg {C.position = C.OnScreen (n+1) o}))
     o -> return (cfg {C.position = C.OnScreen 1 o})
 
-runActions :: D.Actions -> A.Button -> X11.Position -> IO ()
+runAct :: A.Button -> Act -> IO ()
+runAct b (Run r) = E.onClick r b
+runAct b (Act as) =
+  mapM_ A.runAction $ filter (\(A.Spawn bs _) -> b `elem` bs) as
+
+runActions :: Acts -> A.Button -> X11.Position -> IO ()
 runActions actions button pos =
-  mapM_ A.runAction $
-   filter (\(A.Spawn b _) -> button `elem` b) $
-   concatMap (\(a,_,_) -> a) $
+  mapM_ (runAct button) $
+   map (\(a, _, _) -> a) $
    filter (\(_, from, to) -> pos' >= from && pos' <= to) actions
   where pos' = fromIntegral pos