diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Xmobar/Config/Template.hs | 9 | ||||
-rw-r--r-- | src/Xmobar/Run/Actions.hs | 6 | ||||
-rw-r--r-- | src/Xmobar/Run/Loop.hs | 6 | ||||
-rw-r--r-- | src/Xmobar/X11/Loop.hs | 36 |
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 [] |