summaryrefslogtreecommitdiffhomepage
path: root/src/Xmobar/X11/Loop.hs
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2022-09-11 18:54:34 +0100
committerjao <jao@gnu.org>2022-09-11 19:22:57 +0100
commit7b6542e6b13d5457509a3bf79e3ad3ad9a42e48e (patch)
tree136e52af523e4a6924705a92393ebabcc5b95363 /src/Xmobar/X11/Loop.hs
parentd7299a0b80f0b15f820a1b7533549e306755441c (diff)
downloadxmobar-7b6542e6b13d5457509a3bf79e3ad3ad9a42e48e.tar.gz
xmobar-7b6542e6b13d5457509a3bf79e3ad3ad9a42e48e.tar.bz2
x event loop clean-ups
Diffstat (limited to 'src/Xmobar/X11/Loop.hs')
-rw-r--r--src/Xmobar/X11/Loop.hs125
1 files changed, 57 insertions, 68 deletions
diff --git a/src/Xmobar/X11/Loop.hs b/src/Xmobar/X11/Loop.hs
index 8f74b79..4cf4b8f 100644
--- a/src/Xmobar/X11/Loop.hs
+++ b/src/Xmobar/X11/Loop.hs
@@ -19,7 +19,7 @@
module Xmobar.X11.Loop (x11Loop) where
import Prelude hiding (lookup)
-import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment)
+import Graphics.X11.Xlib hiding (textExtents, textWidth, Segment, Button)
import Graphics.X11.Xlib.Extras
import Graphics.X11.Xinerama
import Graphics.X11.Xrandr
@@ -111,59 +111,44 @@ x11EventLoop w signal =
putTMVar signal (Action (ev_button ev) (fi $ ev_x ev))
_ -> return ()
--- | Continuously wait for a signal from a thread or an interrupt handler
--- The list of actions provide also the positions of clickable rectangles
+-- | Continuously wait for a signal from a thread or an interrupt handler.
+-- The list of actions provides the positions of clickable rectangles,
+-- and there is a mutable variable for received signals and the list
+-- of strings updated by running monitors.
signalLoop :: XConf
-> [([Action], Position, Position)]
-> TMVar SignalType
-> TVar [String]
-> IO ()
-signalLoop xc@(XConf d r w fs vos is cfg) as signal tv = do
- typ <- atomically $ takeTMVar signal
- case typ of
- Wakeup -> do
- segs <- updateSegments cfg tv
- xc' <- updateCache d w is (iconRoot cfg) segs >>=
- \c -> return xc { iconS = c }
- as' <- runX xc' $ drawInWin segs
- signalLoop xc' as' signal tv
-
- Reposition ->
- reposWindow cfg
-
- ChangeScreen -> do
- ncfg <- updateConfigPosition cfg
- reposWindow ncfg
-
- Hide t -> hide (t*100*1000)
- Reveal t -> reveal (t*100*1000)
- Toggle t -> toggle t
-
- TogglePersistent -> signalLoop
- xc { config = cfg { persistent = not $ persistent cfg } } as signal tv
-
- SetAlpha a -> signalLoop xc { config = cfg { alpha = a}} as signal tv
-
- Action but x -> action but x
-
+signalLoop xc@(XConf d r w fs vos is cfg) actions signal strs = do
+ typ <- atomically $ takeTMVar signal
+ case typ of
+ Wakeup -> wakeup
+ Action button x -> runActions actions button x >> loopOn
+ Reposition -> reposWindow cfg
+ ChangeScreen -> updateConfigPosition d cfg >>= reposWindow
+ Hide t -> hiderev t Hide hideWindow
+ Reveal t -> hiderev t Reveal (showWindow r cfg)
+ Toggle t -> toggle t
+ TogglePersistent -> updateCfg $ cfg {persistent = not $ persistent cfg}
+ SetAlpha a -> updateCfg $ cfg {alpha = a}
where
- isPersistent = not $ persistent cfg
- loopOn = signalLoop xc as signal tv
- hide t
- | t == 0 =
- when isPersistent (hideWindow d w) >> loopOn
+ loopOn' xc' = signalLoop xc' actions signal strs
+ loopOn = loopOn' xc
+ updateCfg cfg' = loopOn' (xc {config = cfg'})
+
+ wakeup = do
+ segs <- parseSegments cfg strs
+ xc' <- updateIconCache xc segs
+ actions' <- runX xc' $ drawInWin segs
+ signalLoop xc' actions' signal strs
+
+ hiderev t sign op
+ | t == 0 = unless (persistent cfg) (op d w) >> loopOn
| otherwise = do
void $ forkIO
- $ threadDelay t >> atomically (putTMVar signal $ Hide 0)
- loopOn
-
- reveal t
- | t == 0 = do
- when isPersistent (showWindow r cfg d w)
- loopOn
- | otherwise = do
- void $ forkIO
- $ threadDelay t >> atomically (putTMVar signal $ Reveal 0)
+ $ threadDelay (t*100*1000) >>
+ atomically (putTMVar signal $ sign 0)
loopOn
toggle t = do
@@ -173,28 +158,32 @@ signalLoop xc@(XConf d r w fs vos is cfg) as signal tv = do
reposWindow rcfg = do
r' <- repositionWin d w (NE.head fs) rcfg
- signalLoop (XConf d r' w fs vos is rcfg) as signal tv
-
- updateConfigPosition ocfg =
- case position ocfg of
- OnScreen n o -> do
- srs <- getScreenInfo d
- return (if n == length srs
- then
- (ocfg {position = OnScreen 1 o})
- else
- (ocfg {position = OnScreen (n+1) o}))
- o -> return (ocfg {position = OnScreen 1 o})
-
- action button x = do
- mapM_ runAction $
- filter (\(Spawn b _) -> button `elem` b) $
- concatMap (\(a,_,_) -> a) $
- filter (\(_, from, to) -> x >= from && x <= to) as
- loopOn
-
-updateSegments :: Config -> TVar [String] -> IO [[Segment]]
-updateSegments conf v = do
+ signalLoop (XConf d r' w fs vos is rcfg) actions signal strs
+
+parseSegments :: Config -> TVar [String] -> IO [[Segment]]
+parseSegments conf v = do
s <- readTVarIO v
let l:c:r:_ = s ++ repeat ""
liftIO $ mapM (parseString conf) [l, c, r]
+
+updateIconCache :: XConf -> [[Segment]] -> IO XConf
+updateIconCache xc@(XConf d _ w _ _ c cfg) segs = do
+ c' <- updateCache d w c (iconRoot cfg) [p | (Icon p, _, _, _) <- concat segs]
+ return $ xc {iconCache = c'}
+
+updateConfigPosition :: Display -> Config -> IO Config
+updateConfigPosition disp cfg =
+ case position cfg of
+ OnScreen n o -> do
+ srs <- getScreenInfo disp
+ return (if n == length srs
+ then (cfg {position = OnScreen 1 o})
+ else (cfg {position = OnScreen (n+1) o}))
+ o -> return (cfg {position = OnScreen 1 o})
+
+runActions :: [([Action], Position, Position)] -> Button -> Position -> IO ()
+runActions actions button pos =
+ mapM_ runAction $
+ filter (\(Spawn b _) -> button `elem` b) $
+ concatMap (\(a,_,_) -> a) $
+ filter (\(_, from, to) -> pos >= from && pos <= to) actions