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 [] | 
