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/Run/Actions.hs6
-rw-r--r--src/Xmobar/Run/Loop.hs6
-rw-r--r--src/Xmobar/X11/Loop.hs36
4 files changed, 34 insertions, 23 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/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 []