summaryrefslogtreecommitdiffhomepage
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Main.hs4
-rw-r--r--src/Xmobar.hs69
2 files changed, 33 insertions, 40 deletions
diff --git a/src/Main.hs b/src/Main.hs
index 34a298d..0d4c113 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -56,9 +56,9 @@ main = do
fs <- initFont d (font conf)
cls <- mapM (parseTemplate conf) (splitTemplate conf)
vars <- mapM (mapM startCommand) cls
- (r,w, srs) <- createWin d fs conf
+ (r,w) <- createWin d fs conf
sig <- setupSignalHandler
- eventLoop (XConf d r w fs conf) vars sig srs
+ eventLoop (XConf d r w fs conf) vars sig
-- | Splits the template in its parts
splitTemplate :: Config -> [String]
diff --git a/src/Xmobar.hs b/src/Xmobar.hs
index e41c2b7..abf6ab3 100644
--- a/src/Xmobar.hs
+++ b/src/Xmobar.hs
@@ -79,13 +79,12 @@ instance Exception WakeUp
data SignalType = Wakeup | Reposition | ChangeScreen
-- | The event loop
-eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> MVar SignalType -> [Rectangle] -> IO ()
-eventLoop xcfg@(XConf d _ w fs _) vs signal screeninfo = do
+eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> MVar SignalType -> IO ()
+eventLoop xcfg@(XConf d _ w fs _) vs signal = do
tv <- atomically $ newTVar []
- tsrs <- atomically $ newTVar screeninfo
_ <- forkIO (checker tv [] `catch` \(SomeException _) -> putStrLn "Oh Noez checker" >> return ())
- _ <- forkOS (eventer tsrs `catch` \(SomeException _) -> putStrLn "Oh Noez eventer" >>return ())
- go tv xcfg tsrs
+ _ <- forkOS (eventer `catch` \(SomeException _) -> putStrLn "Oh Noez eventer" >>return ())
+ go tv xcfg
where
-- interrupt the drawing thread every time a var is updated
checker tvar ov = do
@@ -99,56 +98,52 @@ eventLoop xcfg@(XConf d _ w fs _) vs signal screeninfo = do
concatV = fmap concat . mapM (readTVar . snd)
- eventer tsrs =
+ eventer =
alloca $ \ptrEventBase ->
alloca $ \ptrErrorBase ->
allocaXEvent $ \e -> do
_ <- xrrQueryExtension d ptrEventBase ptrErrorBase
xrrEventBase <- peek ptrEventBase
+
+ dpy <- openDisplay ""
+ -- keyPressMask is the same value as RRScreenChangeNotify
+ xrrSelectInput dpy (defaultRootWindow dpy) keyPressMask
+ selectInput dpy w (exposureMask .|. structureNotifyMask)
+
forever $ do
- nextEvent d e
+ nextEvent dpy e
ev <- getEvent e
case ev of
- ConfigureEvent {} -> sendRepos
+ ConfigureEvent {} -> putMVar signal Reposition
ExposeEvent {} -> putMVar signal Wakeup
_ ->
-- keyPressMask is the same value as RRScreenChangeNotify
- when ( (fromIntegral (ev_event_type ev) - xrrEventBase) == fromIntegral keyPressMask) sendRepos
- where
- sendRepos = do
- srs <- getScreenInfo d
- atomically $ writeTVar tsrs srs
- putMVar signal Reposition
+ when ( (fromIntegral (ev_event_type ev) - xrrEventBase) == fromIntegral keyPressMask)
+ $ putMVar signal Reposition
-- Continuously wait for a timer interrupt or an expose event
- go tv xc@(XConf _ _ _ _ cfg) tsrs = do
+ go tv xc@(XConf _ _ _ _ cfg) = do
typ <- takeMVar signal
case typ of
Wakeup -> do
runX xc (updateWin tv)
- go tv xc tsrs
- Reposition -> do
- ncfg <- reposWindow cfg
- go tv ncfg tsrs
+ go tv xc
+ Reposition -> reposWindow cfg
ChangeScreen ->
case position cfg of
OnScreen n o -> do
- srs <- readTVarIO tsrs
+ srs <- getScreenInfo d
if n == length srs then do
- ncfg <- reposWindow (cfg {position = OnScreen 1 o})
- go tv ncfg tsrs
- else do
- ncfg <- reposWindow (cfg {position = OnScreen (n+1) o})
- go tv ncfg tsrs
- o -> do
- ncfg <- reposWindow (cfg {position = OnScreen 1 o})
- go tv ncfg tsrs
+ reposWindow (cfg {position = OnScreen 1 o})
+ else
+ reposWindow (cfg {position = OnScreen (n+1) o})
+ o ->
+ reposWindow (cfg {position = OnScreen 1 o})
where
reposWindow rcfg = do
- srs <- readTVarIO tsrs
- r' <- repositionWin d w fs rcfg srs
- return (XConf d r' w fs rcfg)
+ r' <- repositionWin d w fs rcfg
+ go tv (XConf d r' w fs rcfg)
-- | Signal handling
setupSignalHandler :: IO (MVar SignalType)
@@ -186,7 +181,7 @@ startCommand (com,s,ss)
-- $window
-- | The function to create the initial window
-createWin :: Display -> XFont -> Config -> IO (Rectangle,Window,[Rectangle])
+createWin :: Display -> XFont -> Config -> IO (Rectangle,Window)
createWin d fs c = do
let dflt = defaultScreen d
srs <- getScreenInfo d
@@ -195,17 +190,15 @@ createWin d fs c = do
let ht = as + ds + 4
(r,o) = setPosition (position c) srs (fi ht)
win <- newWindow d (defaultScreenOfDisplay d) rootw r o
- -- keyPressMask is the same value as RRScreenChangeNotify
- xrrSelectInput d rootw keyPressMask
- selectInput d win (exposureMask .|. structureNotifyMask)
setProperties r c d win srs
when (lowerOnStart c) (lowerWindow d win)
mapWindow d win
- return (r,win, srs)
+ return (r,win)
-- | Updates the size and position of the window
-repositionWin :: Display -> Window -> XFont -> Config -> [Rectangle] -> IO (Rectangle)
-repositionWin d win fs c srs = do
+repositionWin :: Display -> Window -> XFont -> Config -> IO (Rectangle)
+repositionWin d win fs c = do
+ srs <- getScreenInfo d
(as,ds) <- textExtents fs "0"
let ht = as + ds + 4
(r,_) = setPosition (position c) srs (fi ht)