From bba4b08bb0056d44c3d1535e08ed0a32ed060f1f Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Tue, 30 Aug 2011 21:06:57 +0200 Subject: Init commit handle doesn't get all events. simple c program and simple haskell program are getting all of them. there must be something in xmobar which catches about 3 of the screenchange events ... --- src/XUtil.hsc | 6 ++++++ src/Xmobar.hs | 11 ++++++++++- xmobar.cabal | 1 + 3 files changed, 17 insertions(+), 1 deletion(-) diff --git a/src/XUtil.hsc b/src/XUtil.hsc index d5bb591..6511b10 100644 --- a/src/XUtil.hsc +++ b/src/XUtil.hsc @@ -28,6 +28,7 @@ module XUtil , fi , withColors , DynPixel(..) + , xrrSelectInput ) where import Control.Concurrent @@ -257,3 +258,8 @@ setupLocale = withCString "" (setlocale $ #const LC_ALL) >> return () setupLocale :: IO () setupLocale = return () #endif + +-- XRRSelectInput +#include +foreign import ccall unsafe "X11/extensions/Xrandr.h XRRSelectInput" + xrrSelectInput :: Display -> Window -> EventMask -> IO () diff --git a/src/Xmobar.hs b/src/Xmobar.hs index eb7a1dd..f0c00cb 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -103,6 +103,7 @@ eventLoop xc@(XConf d _ w fs c) vs = block $ do -- event hanlder handle _ ct (ConfigureEvent {ev_window = win}) = do rootw <- rootWindow d (defaultScreen d) + putStrLn "Configure" when (win == rootw) $ block $ do killThread ct destroyWindow d w @@ -111,7 +112,13 @@ eventLoop xc@(XConf d _ w fs c) vs = block $ do handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar) - handle _ _ _ = return () + -- this catches the RRScreenChangeNotify + handle _ ct _ = block $ do + putStrLn "ScreenChange" + killThread ct + destroyWindow d w + (r',w') <- createWin d fs c + eventLoop (XConf d r' w' fs c) vs -- $command @@ -141,6 +148,8 @@ createWin d fs c = do (r,o) = setPosition (position c) srs (fi ht) win <- newWindow d (defaultScreenOfDisplay d) rootw r o selectInput d win (exposureMask .|. structureNotifyMask) + -- RRScreenChangeNotifyMask has the same value as keyPressMask + xrrSelectInput d rootw (keyPressMask) setProperties r c d win srs when (lowerOnStart c) (lowerWindow d win) mapWindow d win diff --git a/xmobar.cabal b/xmobar.cabal index ecafe1d..bb46101 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -82,6 +82,7 @@ executable xmobar if true ghc-options: -funbox-strict-fields -Wall + extra-libraries: Xrandr if impl (ghc == 6.10.1) && arch (x86_64) ghc-options: -O0 -- cgit v1.2.3 From e8f3d5f0e6898e0b48d709267d83b2d4c8c2869f Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Wed, 31 Aug 2011 10:40:47 +0200 Subject: Update on Screen change works But I'm not sure if something is broken now... --- src/Xmobar.hs | 13 ++----------- 1 file changed, 2 insertions(+), 11 deletions(-) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index f0c00cb..462de14 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -101,20 +101,12 @@ eventLoop xc@(XConf d _ w fs c) vs = block $ do go tv ct -- event hanlder - handle _ ct (ConfigureEvent {ev_window = win}) = do - rootw <- rootWindow d (defaultScreen d) - putStrLn "Configure" - when (win == rootw) $ block $ do - killThread ct - destroyWindow d w - (r',w') <- createWin d fs c - eventLoop (XConf d r' w' fs c) vs + handle _ _ (ConfigureEvent {}) = return () handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar) -- this catches the RRScreenChangeNotify handle _ ct _ = block $ do - putStrLn "ScreenChange" killThread ct destroyWindow d w (r',w') <- createWin d fs c @@ -147,9 +139,8 @@ 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 - selectInput d win (exposureMask .|. structureNotifyMask) -- RRScreenChangeNotifyMask has the same value as keyPressMask - xrrSelectInput d rootw (keyPressMask) + xrrSelectInput d rootw keyPressMask setProperties r c d win srs when (lowerOnStart c) (lowerWindow d win) mapWindow d win -- cgit v1.2.3 From 4fe99635e87c4f2262a27bf91c1ab6c7e3ee0988 Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Wed, 31 Aug 2011 13:39:01 +0200 Subject: Working version The last commit removed the exposure event which turned out to be a big problem. Although the bug still exists that not all xrandr events are received when normal events are enabled. To work around this problem a second display is created on which only the xrandr events are enabled. On an exposure event the eventqueue for this display is processed. The results are very good, in the worst case an exposure event must be triggered by the user on xmobar to update its position. --- src/Main.hs | 4 +++- src/Xmobar.hs | 40 ++++++++++++++++++++++++++++------------ 2 files changed, 31 insertions(+), 13 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 18e05e2..941a844 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -42,6 +42,7 @@ import Control.Monad (unless) main :: IO () main = do d <- openDisplay "" + d' <- openDisplay "" args <- getArgs (o,file) <- getOpts args (c,defaultings) <- case file of @@ -60,7 +61,8 @@ main = do cls <- mapM (parseTemplate conf) (splitTemplate conf) vars <- mapM (mapM startCommand) cls (r,w) <- createWin d fs conf - eventLoop (XConf d r w fs conf) vars + _ <- enableXRandrEventListen d' + eventLoop (XConf d d' r w fs conf) vars -- | Splits the template in its parts splitTemplate :: Config -> [String] diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 462de14..97d6990 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -23,7 +23,7 @@ module Xmobar , startCommand -- * Window Management -- $window - , createWin, updateWin + , createWin, updateWin, enableXRandrEventListen -- * Printing -- $print , drawInWin, printStrings @@ -60,6 +60,7 @@ type X = ReaderT XConf IO -- | The ReaderT inner component data XConf = XConf { display :: Display + , xrrDspy :: Display -- display used for XRandr events , rect :: Rectangle , window :: Window , fontS :: XFont @@ -75,7 +76,7 @@ instance Exception WakeUp -- | The event loop eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO () -eventLoop xc@(XConf d _ w fs c) vs = block $ do +eventLoop xc@(XConf d xrrD _ w fs c) vs = block $ do tv <- atomically $ newTVar [] t <- myThreadId ct <- forkIO (checker t tv [] `catch` \(SomeException _) -> return ()) @@ -101,16 +102,24 @@ eventLoop xc@(XConf d _ w fs c) vs = block $ do go tv ct -- event hanlder - handle _ _ (ConfigureEvent {}) = return () + handle _ ct (ConfigureEvent {}) = recreateWindow ct - handle tvar _ (ExposeEvent {}) = runX xc (updateWin tvar) + handle tvar ct (ExposeEvent {}) = block $ do + -- check if there are XRandr events pending + num <- pending xrrD + if num == 0 then + -- if no pending events, make a update + runX xc (updateWin tvar) + else + recreateWindow ct - -- this catches the RRScreenChangeNotify - handle _ ct _ = block $ do - killThread ct - destroyWindow d w - (r',w') <- createWin d fs c - eventLoop (XConf d r' w' fs c) vs + handle _ _ _ = return () + + recreateWindow ct = do + killThread ct + destroyWindow d w + (r',w') <- createWin d fs c + eventLoop (XConf d xrrD r' w' fs c) vs -- $command @@ -129,6 +138,14 @@ startCommand (com,s,ss) -- $window +-- | The function to enable notifications from XRandr +enableXRandrEventListen :: Display -> IO () +enableXRandrEventListen d = do + let dflt = defaultScreen d + rootw <- rootWindow d dflt + -- RRScreenChangeNotifyMask has the same value as keyPressMask + xrrSelectInput d rootw keyPressMask + -- | The function to create the initial window createWin :: Display -> XFont -> Config -> IO (Rectangle,Window) createWin d fs c = do @@ -139,8 +156,7 @@ 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 - -- RRScreenChangeNotifyMask has the same value as keyPressMask - xrrSelectInput d rootw keyPressMask + selectInput d win (exposureMask .|. structureNotifyMask) setProperties r c d win srs when (lowerOnStart c) (lowerWindow d win) mapWindow d win -- cgit v1.2.3 From dbf4ea77dc318f5d3b68651eabc562cd6cefec51 Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Wed, 7 Sep 2011 13:09:52 +0200 Subject: complete reword of the eventLoop *) replaced window destroy and create with a reposition *) replaced the exception for redraw with an MVar *) put nextEvent into an own thread, communication over the MVar *) signal handlers for repositioning and screen swap Notes: *) getScreenInfo is a parameter of eventLoop because it blocks when there is an nextEvent waiting for an new event --- src/Main.hs | 12 ++--- src/XUtil.hsc | 10 +++- src/Xmobar.hs | 143 +++++++++++++++++++++++++++++++++++++++------------------- xmobar.cabal | 2 +- 4 files changed, 110 insertions(+), 57 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 941a844..34a298d 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -41,8 +41,8 @@ import Control.Monad (unless) -- | The main entry point main :: IO () main = do + initThreads d <- openDisplay "" - d' <- openDisplay "" args <- getArgs (o,file) <- getOpts args (c,defaultings) <- case file of @@ -52,17 +52,13 @@ main = do unless (null defaultings) $ putStrLn $ "Fields missing from config defaulted: " ++ intercalate "," defaultings - -- listen for ConfigureEvents on the root window, for xrandr support: - rootw <- rootWindow d (defaultScreen d) - selectInput d rootw structureNotifyMask - conf <- doOpts c o fs <- initFont d (font conf) cls <- mapM (parseTemplate conf) (splitTemplate conf) vars <- mapM (mapM startCommand) cls - (r,w) <- createWin d fs conf - _ <- enableXRandrEventListen d' - eventLoop (XConf d d' r w fs conf) vars + (r,w, srs) <- createWin d fs conf + sig <- setupSignalHandler + eventLoop (XConf d r w fs conf) vars sig srs -- | Splits the template in its parts splitTemplate :: Config -> [String] diff --git a/src/XUtil.hsc b/src/XUtil.hsc index 6511b10..cb0c89a 100644 --- a/src/XUtil.hsc +++ b/src/XUtil.hsc @@ -1,4 +1,4 @@ -{-# OPTIONS -fglasgow-exts #-} +{-# LANGUAGE ForeignFunctionInterface #-} ----------------------------------------------------------------------------- -- | -- Module : XUtil @@ -28,13 +28,15 @@ module XUtil , fi , withColors , DynPixel(..) - , xrrSelectInput + , xrrSelectInput + , xrrQueryExtension ) where import Control.Concurrent import Control.Monad.Trans import Data.IORef import Foreign +import Foreign.C.Types import Graphics.X11.Xlib hiding (textExtents, textWidth) import qualified Graphics.X11.Xlib as Xlib (textExtents, textWidth) import Graphics.X11.Xlib.Extras @@ -263,3 +265,7 @@ setupLocale = return () #include foreign import ccall unsafe "X11/extensions/Xrandr.h XRRSelectInput" xrrSelectInput :: Display -> Window -> EventMask -> IO () + +-- XRRQueryExtension +foreign import ccall unsafe "X11/extensions/Xrandr.h XRRQueryExtension" + xrrQueryExtension :: Display -> Ptr CInt -> Ptr CInt -> IO (Bool) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index 97d6990..e41c2b7 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -18,12 +18,13 @@ module Xmobar -- $main X , XConf (..), runX , eventLoop + , setupSignalHandler -- * Program Execution -- $command , startCommand -- * Window Management -- $window - , createWin, updateWin, enableXRandrEventListen + , createWin, updateWin -- * Printing -- $print , drawInWin, printStrings @@ -42,7 +43,9 @@ import Control.Exception hiding (handle) import Data.Bits import Data.Maybe(fromMaybe) import Data.Typeable (Typeable) +import Foreign import System.Posix.Process (getProcessID) +import System.Posix.Signals import Config import Parsers @@ -60,7 +63,6 @@ type X = ReaderT XConf IO -- | The ReaderT inner component data XConf = XConf { display :: Display - , xrrDspy :: Display -- display used for XRandr events , rect :: Rectangle , window :: Window , fontS :: XFont @@ -74,52 +76,97 @@ runX xc f = runReaderT f xc data WakeUp = WakeUp deriving (Show,Typeable) instance Exception WakeUp +data SignalType = Wakeup | Reposition | ChangeScreen + -- | The event loop -eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO () -eventLoop xc@(XConf d xrrD _ w fs c) vs = block $ do +eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> MVar SignalType -> [Rectangle] -> IO () +eventLoop xcfg@(XConf d _ w fs _) vs signal screeninfo = do tv <- atomically $ newTVar [] - t <- myThreadId - ct <- forkIO (checker t tv [] `catch` \(SomeException _) -> return ()) - go tv ct - where + 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 + where -- interrupt the drawing thread every time a var is updated - checker t tvar ov = do + checker tvar ov = do nval <- atomically $ do nv <- mapM concatV vs guard (nv /= ov) writeTVar tvar nv return nv - throwTo t WakeUp - checker t tvar nval + putMVar signal Wakeup + checker tvar nval concatV = fmap concat . mapM (readTVar . snd) + eventer tsrs = + alloca $ \ptrEventBase -> + alloca $ \ptrErrorBase -> + allocaXEvent $ \e -> do + _ <- xrrQueryExtension d ptrEventBase ptrErrorBase + xrrEventBase <- peek ptrEventBase + forever $ do + nextEvent d e + ev <- getEvent e + case ev of + ConfigureEvent {} -> sendRepos + 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 + + -- Continuously wait for a timer interrupt or an expose event - go tv ct = do - catch (unblock $ allocaXEvent $ \e -> - handle tv ct =<< (nextEvent' d e >> getEvent e)) - (\WakeUp -> runX xc (updateWin tv) >> return ()) - go tv ct - - -- event hanlder - handle _ ct (ConfigureEvent {}) = recreateWindow ct - - handle tvar ct (ExposeEvent {}) = block $ do - -- check if there are XRandr events pending - num <- pending xrrD - if num == 0 then - -- if no pending events, make a update - runX xc (updateWin tvar) - else - recreateWindow ct - - handle _ _ _ = return () - - recreateWindow ct = do - killThread ct - destroyWindow d w - (r',w') <- createWin d fs c - eventLoop (XConf d xrrD r' w' fs c) vs + go tv xc@(XConf _ _ _ _ cfg) tsrs = 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 + ChangeScreen -> + case position cfg of + OnScreen n o -> do + srs <- readTVarIO tsrs + 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 + where + reposWindow rcfg = do + srs <- readTVarIO tsrs + r' <- repositionWin d w fs rcfg srs + return (XConf d r' w fs rcfg) + +-- | Signal handling +setupSignalHandler :: IO (MVar SignalType) +setupSignalHandler = do + tid <- newEmptyMVar + installHandler sigUSR1 (Catch $ updatePosHandler tid) Nothing + installHandler sigHUP (Catch $ changeScreenHandler tid) Nothing + return tid + +updatePosHandler :: MVar SignalType -> IO () +updatePosHandler sig = do + putMVar sig Reposition + return () + +changeScreenHandler :: MVar SignalType -> IO () +changeScreenHandler sig = do + putMVar sig ChangeScreen + return () -- $command @@ -138,16 +185,8 @@ startCommand (com,s,ss) -- $window --- | The function to enable notifications from XRandr -enableXRandrEventListen :: Display -> IO () -enableXRandrEventListen d = do - let dflt = defaultScreen d - rootw <- rootWindow d dflt - -- RRScreenChangeNotifyMask has the same value as keyPressMask - xrrSelectInput d rootw keyPressMask - -- | The function to create the initial window -createWin :: Display -> XFont -> Config -> IO (Rectangle,Window) +createWin :: Display -> XFont -> Config -> IO (Rectangle,Window,[Rectangle]) createWin d fs c = do let dflt = defaultScreen d srs <- getScreenInfo d @@ -156,11 +195,23 @@ 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) + return (r,win, srs) + +-- | Updates the size and position of the window +repositionWin :: Display -> Window -> XFont -> Config -> [Rectangle] -> IO (Rectangle) +repositionWin d win fs c srs = do + (as,ds) <- textExtents fs "0" + let ht = as + ds + 4 + (r,_) = setPosition (position c) srs (fi ht) + moveResizeWindow d win (rect_x r) (rect_y r) (rect_width r) (rect_height r) + setProperties r c d win srs + return r setPosition :: XPosition -> [Rectangle] -> Dimension -> (Rectangle,Bool) setPosition p rs ht = diff --git a/xmobar.cabal b/xmobar.cabal index bb46101..e40494f 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -81,7 +81,7 @@ executable xmobar ghc-prof-options: -prof -auto-all if true - ghc-options: -funbox-strict-fields -Wall + ghc-options: -funbox-strict-fields -Wall -threaded extra-libraries: Xrandr if impl (ghc == 6.10.1) && arch (x86_64) -- cgit v1.2.3 From 735e4098b7d54dc248721a74873317e920b86d2b Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Sat, 10 Sep 2011 16:02:49 +0200 Subject: removed threading problem with Xlib The output just stopped at some point until a new XEvent was received As XLockDisplay is in theory a good idea, with XNextEvent blocking its not usable. As it turned out, a window can be shared between display connections. Now the eventloop has its own display connection (which also removes the need for the lock introduced before). Additionally the screeninfo doesn't need to be fetched into a TVar in the eventerloop anymore. Also this was needed for the signalHandlers to work correctly again. --- src/Main.hs | 4 ++-- src/Xmobar.hs | 69 +++++++++++++++++++++++++++-------------------------------- 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) -- cgit v1.2.3 From b2601191cf84efdd6d0e144385c82e9d3a45cd27 Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Sat, 10 Sep 2011 17:01:10 +0200 Subject: moved signal handler setup into eventloop --- src/Main.hs | 3 +-- src/Xmobar.hs | 24 ++++++++++++------------ 2 files changed, 13 insertions(+), 14 deletions(-) diff --git a/src/Main.hs b/src/Main.hs index 0d4c113..e8efd61 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -57,8 +57,7 @@ main = do cls <- mapM (parseTemplate conf) (splitTemplate conf) vars <- mapM (mapM startCommand) cls (r,w) <- createWin d fs conf - sig <- setupSignalHandler - eventLoop (XConf d r w fs conf) vars sig + eventLoop (XConf d r w fs conf) vars -- | Splits the template in its parts splitTemplate :: Config -> [String] diff --git a/src/Xmobar.hs b/src/Xmobar.hs index abf6ab3..c5613a6 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -18,7 +18,6 @@ module Xmobar -- $main X , XConf (..), runX , eventLoop - , setupSignalHandler -- * Program Execution -- $command , startCommand @@ -79,26 +78,27 @@ instance Exception WakeUp data SignalType = Wakeup | Reposition | ChangeScreen -- | The event loop -eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> MVar SignalType -> IO () -eventLoop xcfg@(XConf d _ w fs _) vs signal = do +eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO () +eventLoop xcfg@(XConf d _ w fs _) vs = do tv <- atomically $ newTVar [] - _ <- forkIO (checker tv [] `catch` \(SomeException _) -> putStrLn "Oh Noez checker" >> return ()) - _ <- forkOS (eventer `catch` \(SomeException _) -> putStrLn "Oh Noez eventer" >>return ()) - go tv xcfg + sig <- setupSignalHandler + _ <- forkIO (checker tv [] sig `catch` \(SomeException _) -> putStrLn "Oh Noez checker" >> return ()) + _ <- forkOS (eventer sig `catch` \(SomeException _) -> putStrLn "Oh Noez eventer" >>return ()) + go tv xcfg sig where -- interrupt the drawing thread every time a var is updated - checker tvar ov = do + checker tvar ov signal = do nval <- atomically $ do nv <- mapM concatV vs guard (nv /= ov) writeTVar tvar nv return nv putMVar signal Wakeup - checker tvar nval + checker tvar nval signal concatV = fmap concat . mapM (readTVar . snd) - eventer = + eventer signal = alloca $ \ptrEventBase -> alloca $ \ptrErrorBase -> allocaXEvent $ \e -> do @@ -123,12 +123,12 @@ eventLoop xcfg@(XConf d _ w fs _) vs signal = do -- Continuously wait for a timer interrupt or an expose event - go tv xc@(XConf _ _ _ _ cfg) = do + go tv xc@(XConf _ _ _ _ cfg) signal = do typ <- takeMVar signal case typ of Wakeup -> do runX xc (updateWin tv) - go tv xc + go tv xc signal Reposition -> reposWindow cfg ChangeScreen -> case position cfg of @@ -143,7 +143,7 @@ eventLoop xcfg@(XConf d _ w fs _) vs signal = do where reposWindow rcfg = do r' <- repositionWin d w fs rcfg - go tv (XConf d r' w fs rcfg) + go tv (XConf d r' w fs rcfg) signal -- | Signal handling setupSignalHandler :: IO (MVar SignalType) -- cgit v1.2.3 From f522e5e5158c53faef472752bdd59901cc704264 Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Sat, 10 Sep 2011 17:15:39 +0200 Subject: Wrong value used to check for xrandr event Didn't tested xrandr events with that event detection. Notify value is 0, the one used (keypress) is 1 --- src/Xmobar.hs | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index c5613a6..efc50e8 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -102,14 +102,15 @@ eventLoop xcfg@(XConf d _ w fs _) vs = do alloca $ \ptrEventBase -> alloca $ \ptrErrorBase -> allocaXEvent $ \e -> do - _ <- xrrQueryExtension d ptrEventBase ptrErrorBase - xrrEventBase <- peek ptrEventBase dpy <- openDisplay "" - -- keyPressMask is the same value as RRScreenChangeNotify + -- keyPressMask is the same value as RRScreenChangeNotifyMask xrrSelectInput dpy (defaultRootWindow dpy) keyPressMask selectInput dpy w (exposureMask .|. structureNotifyMask) + _ <- xrrQueryExtension dpy ptrEventBase ptrErrorBase + xrrEventBase <- peek ptrEventBase + forever $ do nextEvent dpy e ev <- getEvent e @@ -117,8 +118,8 @@ eventLoop xcfg@(XConf d _ w fs _) vs = do ConfigureEvent {} -> putMVar signal Reposition ExposeEvent {} -> putMVar signal Wakeup _ -> - -- keyPressMask is the same value as RRScreenChangeNotify - when ( (fromIntegral (ev_event_type ev) - xrrEventBase) == fromIntegral keyPressMask) + -- 0 is the value of RRScreenChangeNotify + when ( (fromIntegral (ev_event_type ev) - xrrEventBase) == 0) $ putMVar signal Reposition -- cgit v1.2.3 From 7a8b4d611a97de4255131630f578124de5bbf3f4 Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Sun, 11 Sep 2011 17:16:23 +0200 Subject: Minor cleanup --- src/Xmobar.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Xmobar.hs b/src/Xmobar.hs index efc50e8..c107d46 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -82,8 +82,8 @@ eventLoop :: XConf -> [[(Maybe ThreadId, TVar String)]] -> IO () eventLoop xcfg@(XConf d _ w fs _) vs = do tv <- atomically $ newTVar [] sig <- setupSignalHandler - _ <- forkIO (checker tv [] sig `catch` \(SomeException _) -> putStrLn "Oh Noez checker" >> return ()) - _ <- forkOS (eventer sig `catch` \(SomeException _) -> putStrLn "Oh Noez eventer" >>return ()) + _ <- forkIO (checker tv [] sig `catch` \(SomeException _) -> putStrLn "Thread checker failed" >> return ()) + _ <- forkOS (eventer sig `catch` \(SomeException _) -> putStrLn "Thread eventer failed" >> return ()) go tv xcfg sig where -- interrupt the drawing thread every time a var is updated @@ -135,7 +135,7 @@ eventLoop xcfg@(XConf d _ w fs _) vs = do case position cfg of OnScreen n o -> do srs <- getScreenInfo d - if n == length srs then do + if n == length srs then reposWindow (cfg {position = OnScreen 1 o}) else reposWindow (cfg {position = OnScreen (n+1) o}) -- cgit v1.2.3 From 3079f1aab2a82e5a22857ec386ad642b3a62d06b Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Thu, 15 Sep 2011 23:07:37 +0200 Subject: NEWS/README update --- NEWS | 3 +++ README | 8 ++++++++ 2 files changed, 11 insertions(+) diff --git a/NEWS b/NEWS index 361417f..72b4ea9 100644 --- a/NEWS +++ b/NEWS @@ -7,6 +7,7 @@ _New features_ - New brightness monitor, courtesy of Martin Perner. - New DateZone plugin, for localized datetimes, also by Martin. + - Rewrite of the event handling ([issue 53], [issue 57]), also by Martin. - Cpu monitor now also reports `iowait` field ([issue 55]). _Bug fixes_ @@ -20,7 +21,9 @@ _Bug fixes_ [issue 48]: http://code.google.com/p/xmobar/issues/detail?id=48 [issue 50]: http://code.google.com/p/xmobar/issues/detail?id=50 +[issue 53]: http://code.google.com/p/xmobar/issues/detail?id=53 [issue 55]: http://code.google.com/p/xmobar/issues/detail?id=55 +[issue 57]: http://code.google.com/p/xmobar/issues/detail?id=57 ## Version 0.13 (March 28, 2011) diff --git a/README b/README index caaa882..11c94d2 100644 --- a/README +++ b/README @@ -144,6 +144,14 @@ or if you have the default configuration file saved as `~/.xmobarrc` +### Signal Handling + +Since 0.14 xmobar reacts to SIGHUP and SIGUSR1: + +- After receiving SIGHUP xmobar moves its position to the next screen. + +- After receiving SIGUSR1 xmobar repositions it self on the current screen. + Configuration ============= -- cgit v1.2.3 From 8833a8166387075d75ee15690a58cbd2aacf2a67 Mon Sep 17 00:00:00 2001 From: Martin Perner Date: Fri, 16 Sep 2011 13:13:47 +0200 Subject: Changes signals used Switches HUP to USR1 and USR1 to USR2, as requested --- README | 6 +++--- src/Xmobar.hs | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/README b/README index 11c94d2..55254a6 100644 --- a/README +++ b/README @@ -146,11 +146,11 @@ if you have the default configuration file saved as `~/.xmobarrc` ### Signal Handling -Since 0.14 xmobar reacts to SIGHUP and SIGUSR1: +Since 0.14 xmobar reacts to SIGUSR1 and SIGUSR2: -- After receiving SIGHUP xmobar moves its position to the next screen. +- After receiving SIGUSR1 xmobar moves its position to the next screen. -- After receiving SIGUSR1 xmobar repositions it self on the current screen. +- After receiving SIGUSR2 xmobar repositions it self on the current screen. Configuration ============= diff --git a/src/Xmobar.hs b/src/Xmobar.hs index c107d46..37fd653 100644 --- a/src/Xmobar.hs +++ b/src/Xmobar.hs @@ -150,8 +150,8 @@ eventLoop xcfg@(XConf d _ w fs _) vs = do setupSignalHandler :: IO (MVar SignalType) setupSignalHandler = do tid <- newEmptyMVar - installHandler sigUSR1 (Catch $ updatePosHandler tid) Nothing - installHandler sigHUP (Catch $ changeScreenHandler tid) Nothing + installHandler sigUSR2 (Catch $ updatePosHandler tid) Nothing + installHandler sigUSR1 (Catch $ changeScreenHandler tid) Nothing return tid updatePosHandler :: MVar SignalType -> IO () -- cgit v1.2.3