summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Xmobar/App/Main.hs6
-rw-r--r--src/Xmobar/Run/Loop.hs14
-rw-r--r--src/Xmobar/Text/Loop.hs35
-rw-r--r--src/Xmobar/X11/Loop.hs103
4 files changed, 69 insertions, 89 deletions
diff --git a/src/Xmobar/App/Main.hs b/src/Xmobar/App/Main.hs
index 52cdca5..489bcd0 100644
--- a/src/Xmobar/App/Main.hs
+++ b/src/Xmobar/App/Main.hs
@@ -29,13 +29,13 @@ import Control.Monad (unless)
import Xmobar.App.Config
import Xmobar.Config.Types
import Xmobar.Config.Parse
-import qualified Xmobar.X11.Loop as X11
-import qualified Xmobar.Text.Loop as Text
+import Xmobar.X11.Loop (x11Loop)
+import Xmobar.Text.Loop (textLoop)
import Xmobar.App.Opts (recompileFlag, verboseFlag, getOpts, doOpts)
import Xmobar.App.Compile (recompile, trace)
xmobar :: Config -> IO ()
-xmobar cfg = if textOutput cfg then Text.loop cfg else X11.loop cfg
+xmobar cfg = if textOutput cfg then textLoop cfg else x11Loop cfg
configFromArgs :: Config -> IO Config
configFromArgs cfg = getArgs >>= getOpts >>= doOpts cfg . fst
diff --git a/src/Xmobar/Run/Loop.hs b/src/Xmobar/Run/Loop.hs
index 30ee112..bda41ff 100644
--- a/src/Xmobar/Run/Loop.hs
+++ b/src/Xmobar/Run/Loop.hs
@@ -16,7 +16,7 @@
--
------------------------------------------------------------------------------
-module Xmobar.Run.Loop (initLoop, loop) where
+module Xmobar.Run.Loop (LoopFunction, loop) where
import Control.Concurrent (forkIO)
import Control.Exception (bracket_, bracket, handle, SomeException(..))
@@ -53,13 +53,10 @@ refreshLockT var action = do
putTMVar var ()
return r
-type StartFunction = TMVar SignalType
- -> TMVar ()
- -> [[([Async ()], TVar String)]]
- -> IO ()
+type LoopFunction = TMVar SignalType -> TVar [String] -> IO ()
-loop :: Config -> StartFunction -> IO ()
-loop conf starter = withDeferSignals $ do
+loop :: Config -> LoopFunction -> IO ()
+loop conf looper = withDeferSignals $ do
cls <- mapM (parseTemplate (commands conf) (sepChar conf))
(splitTemplate (alignSep conf) (template conf))
let confSig = unSignalChan (signal conf)
@@ -70,7 +67,8 @@ loop conf starter = withDeferSignals $ do
bracket (mapM (mapM $ startCommand sig) cls)
cleanupThreads
$ \vars -> do
- starter sig refLock vars
+ tv <- initLoop sig refLock vars
+ looper sig tv
cleanupThreads :: [[([Async ()], a)]] -> IO ()
cleanupThreads vars =
diff --git a/src/Xmobar/Text/Loop.hs b/src/Xmobar/Text/Loop.hs
index 42c8700..2903aa9 100644
--- a/src/Xmobar/Text/Loop.hs
+++ b/src/Xmobar/Text/Loop.hs
@@ -14,48 +14,35 @@
--
------------------------------------------------------------------------------
-module Xmobar.Text.Loop (loop) where
+module Xmobar.Text.Loop (textLoop) where
import Prelude hiding (lookup)
import System.IO
import Control.Monad.Reader
-import Control.Concurrent.Async (Async)
import Control.Concurrent.STM
import Xmobar.System.Signal
-
import Xmobar.Config.Types (Config)
-
-import qualified Xmobar.Run.Loop as Loop
-
+import Xmobar.Run.Loop (loop)
import Xmobar.Run.Parsers (parseString)
-
import Xmobar.Text.Output (formatSegment)
-- | Starts the main event loop and threads
-loop :: Config -> IO ()
-loop conf = Loop.loop conf (startTextLoop' conf)
-
-startTextLoop' :: Config
- -> TMVar SignalType
- -> TMVar ()
- -> [[([Async ()], TVar String)]]
- -> IO ()
-startTextLoop' cfg sig pauser vs = do
- hSetBuffering stdin LineBuffering
- hSetBuffering stdout LineBuffering
- tv <- Loop.initLoop sig pauser vs
- eventLoop cfg tv sig
+textLoop :: Config -> IO ()
+textLoop conf = do
+ hSetBuffering stdin LineBuffering
+ hSetBuffering stdout LineBuffering
+ loop conf (eventLoop conf)
-- | Continuously wait for a signal from a thread or a interrupt handler
-eventLoop :: Config -> TVar [String] -> TMVar SignalType -> IO ()
-eventLoop cfg tv signal = do
+eventLoop :: Config -> TMVar SignalType -> TVar [String] -> IO ()
+eventLoop cfg signal tv = do
typ <- atomically $ takeTMVar signal
case typ of
- Wakeup -> updateString cfg tv >>= putStrLn >> eventLoop cfg tv signal
- _ -> eventLoop cfg tv signal
+ Wakeup -> updateString cfg tv >>= putStrLn >> eventLoop cfg signal tv
+ _ -> eventLoop cfg 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 840c16e..c74ae57 100644
--- a/src/Xmobar/X11/Loop.hs
+++ b/src/Xmobar/X11/Loop.hs
@@ -16,7 +16,7 @@
--
------------------------------------------------------------------------------
-module Xmobar.X11.Loop (loop) where
+module Xmobar.X11.Loop (x11Loop) where
import Prelude hiding (lookup)
import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment)
@@ -27,7 +27,6 @@ import Graphics.X11.Xrandr
import Control.Arrow ((&&&))
import Control.Monad.Reader
import Control.Concurrent
-import Control.Concurrent.Async (Async)
import Control.Concurrent.STM
import Control.Exception (handle, SomeException(..))
import Data.Bits
@@ -59,7 +58,7 @@ import Xmobar.X11.Bitmap as Bitmap
import Xmobar.X11.Types
import Xmobar.System.Utils (safeIndex)
-import qualified Xmobar.Run.Loop as Loop
+import Xmobar.Run.Loop (loop)
#ifndef THREADED_RUNTIME
import Xmobar.X11.Events(nextEvent')
@@ -73,8 +72,8 @@ runX :: XConf -> X () -> IO ()
runX xc f = runReaderT f xc
-- | Starts the main event loop and threads
-loop :: Config -> IO ()
-loop conf = do
+x11Loop :: Config -> IO ()
+x11Loop conf = do
initThreads
d <- openDisplay ""
fs <- initFont d (font conf)
@@ -82,58 +81,54 @@ loop conf = do
let ic = Map.empty
to = textOffset conf
ts = textOffsets conf ++ replicate (length fl) (-1)
- Loop.loop conf $ \sig lock vars -> do
- (r,w) <- createWin d fs conf
- startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf) sig lock vars
+ (r,w) <- createWin d fs conf
+ loop conf (startLoop (XConf d r w (fs :| fl) (to :| ts) ic conf))
-startLoop :: XConf
- -> TMVar SignalType
- -> TMVar ()
- -> [[([Async ()], TVar String)]]
- -> IO ()
-startLoop xcfg@(XConf _ _ w _ _ _ _) sig pauser vs = do
+startLoop :: XConf -> TMVar SignalType -> TVar [String] -> IO ()
+startLoop xcfg@(XConf _ _ w _ _ _ _) sig tv = do
#ifdef XFT
xftInitFtLibrary
#endif
- tv <- Loop.initLoop sig pauser vs
#ifdef THREADED_RUNTIME
- _ <- forkOS (handle (handler "eventer") (eventer sig))
+ _ <- forkOS (handle (handler "X event handler") (handleXEvent w sig))
#else
- _ <- forkIO (handle (handler "eventer") (eventer sig))
+ _ <- forkIO (handle (handler "X event handler") (handleXEvent w sig))
#endif
- eventLoop tv xcfg [] sig
+ eventLoop xcfg [] sig tv
where
handler thing (SomeException e) =
void $ putStrLn ("Thread " ++ thing ++ " failed: " ++ show e)
- -- Reacts on events from X
- eventer signal =
- allocaXEvent $ \e -> do
- dpy <- openDisplay ""
- xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
- selectInput dpy w (exposureMask .|. structureNotifyMask .|. buttonPressMask)
-
- forever $ do
+
+-- | Translates X11 events received by w to signals handled by eventLoop
+handleXEvent :: Window -> TMVar SignalType -> IO ()
+handleXEvent w signal =
+ allocaXEvent $ \e -> do
+ dpy <- openDisplay ""
+ xrrSelectInput dpy (defaultRootWindow dpy) rrScreenChangeNotifyMask
+ selectInput dpy w (exposureMask .|. structureNotifyMask .|. buttonPressMask)
+
+ forever $ do
#ifdef THREADED_RUNTIME
- nextEvent dpy e
+ nextEvent dpy e
#else
- nextEvent' dpy e
+ nextEvent' dpy e
#endif
- ev <- getEvent e
- case ev of
- ConfigureEvent {} -> atomically $ putTMVar signal Reposition
- ExposeEvent {} -> atomically $ putTMVar signal Wakeup
- RRScreenChangeNotifyEvent {} -> atomically $ putTMVar signal Reposition
- ButtonEvent {} -> atomically $
- putTMVar signal (Action (ev_button ev) (fi $ ev_x ev))
- _ -> return ()
-
--- | Continuously wait for a signal from a thread or a interrupt handler
-eventLoop :: TVar [String]
- -> XConf
- -> [([Action], Position, Position)]
- -> TMVar SignalType
- -> IO ()
-eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do
+ ev <- getEvent e
+ case ev of
+ ConfigureEvent {} -> atomically $ putTMVar signal Reposition
+ ExposeEvent {} -> atomically $ putTMVar signal Wakeup
+ RRScreenChangeNotifyEvent {} -> atomically $ putTMVar signal Reposition
+ ButtonEvent {} -> atomically $
+ putTMVar signal (Action (ev_button ev) (fi $ ev_x ev))
+ _ -> return ()
+
+-- | Continuously wait for a signal from a thread or an interrupt handler
+eventLoop :: XConf
+ -> [([Action], Position, Position)]
+ -> TMVar SignalType
+ -> TVar [String]
+ -> IO ()
+eventLoop xc@(XConf d r w fs vos is cfg) as signal tv = do
typ <- atomically $ takeTMVar signal
case typ of
Wakeup -> do
@@ -142,7 +137,7 @@ eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do
\c -> return xc { iconS = c }
as' <- updateActions xc r str
runX xc' $ drawInWin r str
- eventLoop tv xc' as' signal
+ eventLoop xc' as' signal tv
Reposition ->
reposWindow cfg
@@ -156,38 +151,38 @@ eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do
Toggle t -> toggle t
TogglePersistent -> eventLoop
- tv xc { config = cfg { persistent = not $ persistent cfg } } as signal
+ xc { config = cfg { persistent = not $ persistent cfg } } as signal tv
Action but x -> action but x
where
isPersistent = not $ persistent cfg
-
+ loopOn = eventLoop xc as signal tv
hide t
| t == 0 =
- when isPersistent (hideWindow d w) >> eventLoop tv xc as signal
+ when isPersistent (hideWindow d w) >> loopOn
| otherwise = do
void $ forkIO
$ threadDelay t >> atomically (putTMVar signal $ Hide 0)
- eventLoop tv xc as signal
+ loopOn
reveal t
| t == 0 = do
when isPersistent (showWindow r cfg d w)
- eventLoop tv xc as signal
+ loopOn
| otherwise = do
void $ forkIO
$ threadDelay t >> atomically (putTMVar signal $ Reveal 0)
- eventLoop tv xc as signal
+ loopOn
toggle t = do
ismapped <- isMapped d w
atomically (putTMVar signal $ if ismapped then Hide t else Reveal t)
- eventLoop tv xc as signal
+ loopOn
reposWindow rcfg = do
r' <- repositionWin d w (NE.head fs) rcfg
- eventLoop tv (XConf d r' w fs vos is rcfg) as signal
+ eventLoop (XConf d r' w fs vos is rcfg) as signal tv
updateConfigPosition ocfg =
case position ocfg of
@@ -205,7 +200,7 @@ eventLoop tv xc@(XConf d r w fs vos is cfg) as signal = do
filter (\(Spawn b _) -> button `elem` b) $
concatMap (\(a,_,_) -> a) $
filter (\(_, from, to) -> x >= from && x <= to) as
- eventLoop tv xc as signal
+ loopOn
updateString :: Config -> TVar [String] -> IO [[Segment]]
updateString conf v = do
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-10 23:40:50 +0000