summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/Xmobar/Draw/Cairo.hs6
-rw-r--r--src/Xmobar/Run/Exec.hs3
-rw-r--r--src/Xmobar/Run/Loop.hs8
-rw-r--r--src/Xmobar/Run/Runnable.hs1
-rw-r--r--src/Xmobar/Text/Loop.hs11
-rw-r--r--src/Xmobar/X11/Loop.hs52
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
generated by cgit v1.2.3 (git 2.46.0) at 2025-02-11 19:00:50 +0000