summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Xmobar/Config/Template.hs9
-rw-r--r--src/Xmobar/Draw/Cairo.hs8
-rw-r--r--src/Xmobar/Plugins/MarqueePipeReader.hs2
-rw-r--r--src/Xmobar/Plugins/Monitors/Top.hs6
-rw-r--r--src/Xmobar/Run/Actions.hs6
-rw-r--r--src/Xmobar/Run/Exec.hs3
-rw-r--r--src/Xmobar/Run/Loop.hs15
-rw-r--r--src/Xmobar/Run/Runnable.hs1
-rw-r--r--src/Xmobar/Text/Loop.hs11
-rw-r--r--src/Xmobar/X11/Loop.hs56
10 files changed, 79 insertions, 38 deletions
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 = "<action=>" ++ str ++ "</action>"
+
actionParser :: Context -> Parser [T.Segment]
actionParser (ti, fi, act) = do
P.string "<action="
command <- C.between (P.char '`') (P.char '`') (C.many1 (P.noneOf "`"))
- <|> 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/Draw/Cairo.hs b/src/Xmobar/Draw/Cairo.hs
index 2338b10..cc35631 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
@@ -193,4 +195,4 @@ drawSegments dctx surf = do
(_, as'', bx'') <- foldM (drawSegment dctx surf dw) (rstart, as', bx') rlyts
drawBoxes dctx surf (reverse bx'')
when (C.borderWidth conf > 0) (drawBorder conf dw dh surf)
- return as''
+ return (reverse as'')
diff --git a/src/Xmobar/Plugins/MarqueePipeReader.hs b/src/Xmobar/Plugins/MarqueePipeReader.hs
index 075503c..a6d590e 100644
--- a/src/Xmobar/Plugins/MarqueePipeReader.hs
+++ b/src/Xmobar/Plugins/MarqueePipeReader.hs
@@ -60,7 +60,7 @@ writer txt sep len rate chan cb = do
Nothing -> tenthSeconds rate >> writer (drop 1 txt) sep len rate chan cb
toInfTxt :: String -> String -> String
-toInfTxt line sep = concat (repeat $ line ++ " " ++ sep ++ " ")
+toInfTxt line sep = cycle (line ++ " " ++ sep ++ " ")
checkPipe :: FilePath -> IO ()
checkPipe file = handle (\(SomeException _) -> waitForPipe) $ do
diff --git a/src/Xmobar/Plugins/Monitors/Top.hs b/src/Xmobar/Plugins/Monitors/Top.hs
index 3bfe6fd..7066307 100644
--- a/src/Xmobar/Plugins/Monitors/Top.hs
+++ b/src/Xmobar/Plugins/Monitors/Top.hs
@@ -3,7 +3,7 @@
-----------------------------------------------------------------------------
-- |
-- Module : Plugins.Monitors.Top
--- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018, 2022 Jose A Ortega Ruiz
+-- Copyright : (c) 2010, 2011, 2012, 2013, 2014, 2018, 2022, 2025 Jose A Ortega Ruiz
-- License : BSD-style (see LICENSE)
--
-- Maintainer : Jose A Ortega Ruiz <jao@gnu.org>
@@ -20,7 +20,7 @@ import Xmobar.Plugins.Monitors.Common
import Data.IORef (newIORef, readIORef, writeIORef)
import Data.List (sortBy)
-import Data.Ord (comparing)
+import Data.Ord (comparing, Down (..))
import Data.Time.Clock (getCurrentTime, diffUTCTime)
import Xmobar.Plugins.Monitors.Top.Common (
@@ -66,7 +66,7 @@ showInfo nm sms mms = do
sortTop :: [(String, Float)] -> [(String, Float)]
-sortTop = sortBy (flip (comparing snd))
+sortTop = sortBy (comparing (Down . snd))
showMemInfo :: Float -> MemInfo -> Monitor [String]
showMemInfo scale (nm, rss) =
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/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..343a857 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
@@ -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
@@ -53,13 +54,14 @@ 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)
+ runners = map (\(r, _, _) -> r) (concat cls)
sig <- maybe newEmptyTMVarIO pure confSig
unless (isJust confSig) $ setupSignalHandler sig
refLock <- newRefreshLock
@@ -68,7 +70,7 @@ loop conf looper = withDeferSignals $ do
cleanupThreads
$ \vars -> do
tv <- initLoop sig refLock vars
- looper sig tv
+ looper runners sig tv
cleanupThreads :: [[([Async ()], a)]] -> IO ()
cleanupThreads vars =
@@ -93,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/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..834b1f6 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,10 @@ import qualified Xmobar.X11.Window as W
import qualified Xmobar.X11.Events as E
#endif
+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
@@ -69,10 +75,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 +109,18 @@ eventLoop dpy w signalv =
where (b, p) = (X11x.ev_button ev, fromIntegral $ X11x.ev_x ev)
_ -> return ()
+
-- | 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
case typ of
S.Wakeup -> wakeup
- S.Action button x -> runActions actions 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
@@ -118,7 +129,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 +137,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 +155,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 +178,21 @@ 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 ()
-runActions actions button pos =
- mapM_ A.runAction $
- filter (\(A.Spawn b _) -> button `elem` b) $
- concatMap (\(a,_,_) -> a) $
- filter (\(_, from, to) -> pos' >= from && pos' <= to) actions
+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
+
+runActions :: [R.Runnable] -> D.Actions -> A.Button -> X11.Position -> IO ()
+runActions runs actions button pos =
+ mapM_ (runAct button) $
+ filter (\(_, from, to) -> pos' >= from && pos' < to) acts
where pos' = fromIntegral pos
+ acts = toActs runs actions []
generated by cgit v1.2.3 (git 2.46.0) at 2025-02-14 12:46:55 +0000