prototype for onClick method in Exec

1 files changed, 37 insertions, 15 deletions

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