Add native error handler for systray

1 files changed, 14 insertions, 24 deletions

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