diff options
Diffstat (limited to 'src/Xmobar/App')
| -rw-r--r-- | src/Xmobar/App/CommandThreads.hs | 61 | ||||
| -rw-r--r-- | src/Xmobar/App/EventLoop.hs | 59 | ||||
| -rw-r--r-- | src/Xmobar/App/Main.hs | 3 | 
3 files changed, 75 insertions, 48 deletions
| diff --git a/src/Xmobar/App/CommandThreads.hs b/src/Xmobar/App/CommandThreads.hs new file mode 100644 index 0000000..1de2936 --- /dev/null +++ b/src/Xmobar/App/CommandThreads.hs @@ -0,0 +1,61 @@ +------------------------------------------------------------------------------ +-- | +-- Module: Xmobar.App.CommandThreads +-- Copyright: (c) 2022 Jose Antonio Ortega Ruiz +-- License: BSD3-style (see LICENSE) +-- +-- Maintainer: jao@gnu.org +-- Stability: unstable +-- Portability: unportable +-- Created: Fri Jan 28, 2022 03:20 +-- +-- +-- Running a thread for each defined Command +-- +------------------------------------------------------------------------------ + +module Xmobar.App.CommandThreads ( startCommand +                                 , newRefreshLock +                                 , refreshLock +                                 , refreshLockT) where + +import Control.Concurrent.STM +import Control.Concurrent.Async (Async, async) +import Control.Exception (bracket_) + +import Xmobar.System.Signal (SignalType) +import Xmobar.Run.Runnable (Runnable) +import Xmobar.Run.Exec (start, trigger, alias) + +newRefreshLock :: IO (TMVar ()) +newRefreshLock = newTMVarIO () + +refreshLock :: TMVar () -> IO a -> IO a +refreshLock var = bracket_ lock unlock +    where +        lock = atomically $ takeTMVar var +        unlock = atomically $ putTMVar var () + +refreshLockT :: TMVar () -> STM a -> STM a +refreshLockT var action = do +    takeTMVar var +    r <- action +    putTMVar var () +    return r + +-- | 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) +             -> 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) +                     a1 <- async $ start com cb +                     a2 <- async $ trigger com $ maybe (return ()) +                                                 (atomically . putTMVar sig) +                     return ([a1, a2], var) +    where is = s ++ "Updating..." ++ ss diff --git a/src/Xmobar/App/EventLoop.hs b/src/Xmobar/App/EventLoop.hs index f046647..1764b1d 100644 --- a/src/Xmobar/App/EventLoop.hs +++ b/src/Xmobar/App/EventLoop.hs @@ -16,13 +16,7 @@  --  ------------------------------------------------------------------------------ - -module Xmobar.App.EventLoop -    ( startLoop -    , startCommand -    , newRefreshLock -    , refreshLock -    ) where +module Xmobar.App.EventLoop (startLoop) where  import Prelude hiding (lookup)  import Graphics.X11.Xlib hiding (textExtents, textWidth) @@ -33,18 +27,22 @@ import Graphics.X11.Xrandr  import Control.Arrow ((&&&))  import Control.Monad.Reader  import Control.Concurrent -import Control.Concurrent.Async (Async, async) +import Control.Concurrent.Async (Async)  import Control.Concurrent.STM -import Control.Exception (bracket_, handle, SomeException(..)) +import Control.Exception (handle, SomeException(..))  import Data.Bits  import Data.Map hiding (foldr, map, filter)  import Data.Maybe (fromJust, isJust)  import qualified Data.List.NonEmpty as NE  import Xmobar.System.Signal -import Xmobar.Config.Types (persistent, position, iconRoot, Config, Align(..), XPosition(..)) -import Xmobar.Run.Exec -import Xmobar.Run.Runnable +import Xmobar.Config.Types (persistent +                           , position +                           , iconRoot +                           , Config +                           , Align(..) +                           , XPosition(..)) +  import Xmobar.X11.Actions  import Xmobar.X11.Parsers  import Xmobar.X11.Window @@ -54,6 +52,8 @@ import Xmobar.X11.Bitmap as Bitmap  import Xmobar.X11.Types  import Xmobar.System.Utils (safeIndex) +import Xmobar.App.CommandThreads (refreshLockT) +  #ifndef THREADED_RUNTIME  import Xmobar.X11.Events(nextEvent')  #endif @@ -69,22 +69,6 @@ import Xmobar.System.DBus  runX :: XConf -> X () -> IO ()  runX xc f = runReaderT f xc -newRefreshLock :: IO (TMVar ()) -newRefreshLock = newTMVarIO () - -refreshLock :: TMVar () -> IO a -> IO a -refreshLock var = bracket_ lock unlock -    where -        lock = atomically $ takeTMVar var -        unlock = atomically $ putTMVar var () - -refreshLockT :: TMVar () -> STM a -> STM a -refreshLockT var action = do -    takeTMVar var -    r <- action -    putTMVar var () -    return r -  -- | Starts the main event loop and threads  startLoop :: XConf            -> TMVar SignalType @@ -230,25 +214,6 @@ eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do              filter (\(_, from, to) -> x >= from && x <= to) as            eventLoop tv xc as signal --- $command - --- | 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) -             -> 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) -                     a1 <- async $ start com cb -                     a2 <- async $ trigger com $ maybe (return ()) -                                                 (atomically . putTMVar sig) -                     return ([a1, a2], var) -    where is = s ++ "Updating..." ++ ss -  updateString :: Config               -> TVar [String]               -> IO [[(Widget, TextRenderInfo, Int, Maybe [Action])]] diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs index 6a3203f..b67012d 100644 --- a/src/Xmobar/App/Main.hs +++ b/src/Xmobar/App/Main.hs @@ -42,7 +42,8 @@ import Xmobar.X11.Types  import Xmobar.X11.Text  import Xmobar.X11.Window  import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts) -import Xmobar.App.EventLoop (startLoop, startCommand, newRefreshLock, refreshLock) +import Xmobar.App.EventLoop (startLoop) +import Xmobar.App.CommandThreads (startCommand, newRefreshLock, refreshLock)  import Xmobar.App.Compile (recompile, trace)  import Xmobar.App.Config  import Xmobar.App.Timer (withTimer) | 
