diff options
Diffstat (limited to 'lib/Phi')
| -rw-r--r-- | lib/Phi/Bindings/SystrayErrorHandler.hsc | 17 | ||||
| -rw-r--r-- | lib/Phi/Widgets/Systray.hs | 38 | ||||
| -rw-r--r-- | lib/Phi/X11.hs | 2 |
3 files changed, 32 insertions, 25 deletions
diff --git a/lib/Phi/Bindings/SystrayErrorHandler.hsc b/lib/Phi/Bindings/SystrayErrorHandler.hsc new file mode 100644 index 0000000..73fedbb --- /dev/null +++ b/lib/Phi/Bindings/SystrayErrorHandler.hsc @@ -0,0 +1,17 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Phi.Bindings.SystrayErrorHandler ( setSystrayErrorHandler + , getLastErrorWindow + ) where + +#include <SystrayErrorHandler.h> + + +import Graphics.X11.Xlib + + +foreign import ccall unsafe "SystrayErrorHandler.h setSystrayErrorHandler" + setSystrayErrorHandler :: IO () + +foreign import ccall unsafe "SystrayErrorHandler.h getLastErrorWindow" + getLastErrorWindow :: IO Window diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs index 0d14f0e..2f8de56 100644 --- a/lib/Phi/Widgets/Systray.hs +++ b/lib/Phi/Widgets/Systray.hs @@ -24,6 +24,7 @@ import qualified Graphics.X11.Xlib as Xlib import Graphics.X11.Xlib.Extras import Phi.Bindings.Util +import Phi.Bindings.SystrayErrorHandler import Phi.Phi import Phi.Types @@ -103,16 +104,10 @@ systrayRunner phi dispvar = do _ -> case (fromMessage m) of Just (RenderIcon midParent window x y w h reset) -> do - errorWindowRef <- liftIO $ newIORef [] - withDisplay dispvar $ \disp -> do liftIO $ flip catch (\_ -> return ()) $ do sync disp False - setErrorHandler $ \disp eventptr -> do - event <- getErrorEvent eventptr - when (ev_error_code event == fromIntegral badWindow) $ do - errorWindows <- readIORef errorWindowRef - writeIORef errorWindowRef (ev_resourceid event:errorWindows) + setSystrayErrorHandler (_, x', y', w', h', _, _) <- getGeometry disp midParent (_, _, _, w'', h'', _, _) <- getGeometry disp window @@ -124,14 +119,15 @@ systrayRunner phi dispvar = do resizeWindow disp window (fromIntegral w) (fromIntegral h) sync disp False - when (resize || reset) $ do - clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True - sync disp False - + clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True + + sync disp False xSetErrorHandler - errorWindows <- liftIO $ readIORef errorWindowRef - mapM_ (removeIcon phi disp) errorWindows + lastErrorWindow <- liftIO $ getLastErrorWindow + when (lastErrorWindow == window) $ do + liftIO $ print window + removeIcon phi disp window _ -> case (fromMessage m) of Just Shutdown -> do @@ -234,24 +230,18 @@ addIcon :: Phi -> Xlib.Display -> Atoms -> Window -> Window -> StateT (M.Map Win addIcon phi disp atoms panelWindow window = do liftIO $ selectInput disp window $ structureNotifyMask .|. propertyChangeMask - errorRef <- liftIO $ newIORef False midParent <- liftIO $ createSimpleWindow disp panelWindow (-16) (-16) 16 16 0 0 0 liftIO $ do setWindowBackgroundPixmap disp midParent 1 -- ParentRelative sync disp False - setErrorHandler $ \disp eventptr -> do - event <- getErrorEvent eventptr - when (ev_error_code event == fromIntegral badWindow && ev_resourceid event == window) $ - writeIORef errorRef True + setSystrayErrorHandler reparentWindow disp window midParent 0 0 - sync disp False mapRaised disp midParent mapWindow disp window - sync disp False allocaXEvent $ \event -> do putClientMessage event window (atom_XEMBED atoms) [fromIntegral currentTime, fromIntegral xEMBED_EMBEDDED_NOTIFY, 0, fromIntegral midParent, 0] @@ -260,13 +250,13 @@ addIcon phi disp atoms panelWindow window = do sync disp False xSetErrorHandler - error <- liftIO $ readIORef errorRef - case error of - False -> do + errorWindow <- liftIO $ getLastErrorWindow + case True of + _ | errorWindow /= window -> do sendMessage phi $ AddIcon midParent window sendMessage phi Repaint modify $ M.insert window midParent - True -> + | otherwise -> liftIO $ destroyWindow disp midParent diff --git a/lib/Phi/X11.hs b/lib/Phi/X11.hs index 9bd5cd4..f0cf62c 100644 --- a/lib/Phi/X11.hs +++ b/lib/Phi/X11.hs @@ -223,7 +223,6 @@ updatePanels dispvar = do -- copy buffer to window liftIO $ do - setWindowBackgroundPixmap disp (panelWindow panel') pixmap (withDimension area $ clearArea disp (panelWindow panel') 0 0) True sync disp False @@ -282,6 +281,7 @@ createPanel disp win widgets screenRect = do depth = defaultDepth disp screen pixmap <- liftIO $ (withDimension rect $ createPixmap disp win) depth + liftIO $ setWindowBackgroundPixmap disp win pixmap return PanelState { panelWindow = win , panelPixmap = pixmap |