Add native error handler for systray

csrc/SystrayErrorHandler.c

@@ -0,0 +1,27 @@
+#include <SystrayErrorHandler.h>
+
+
+static Window lastErrorWindow = 0;
+
+
+static int systrayErrorHandler (Display *display, XErrorEvent *event)
+{
+	if (event->error_code == BadWindow) {
+		lastErrorWindow = event->resourceid;
+	}
+
+	return 0;
+}
+
+void setSystrayErrorHandler (void)
+{
+	lastErrorWindow = 0;
+	XSetErrorHandler(systrayErrorHandler);
+}
+
+Window getLastErrorWindow (void)
+{
+	Window ret = lastErrorWindow;
+	lastErrorWindow = 0;
+	return ret;
+}

include/SystrayErrorHandler.h

@@ -0,0 +1,11 @@
+#ifndef _PHI_SYSTRAYERRORHANDLER_H_
+#define _PHI_SYSTRAYERRORHANDLER_H_
+
+#include <X11/Xlib.h>
+
+
+void setSystrayErrorHandler (void);
+
+Window getLastErrorWindow (void);
+
+#endif /* _PHI_SYSTRAYERRORHANDLER_H_ */

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

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
 
 

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

phi.cabal

@@ -14,7 +14,9 @@ library
   build-depends:     base >= 4, template-haskell, stm, array, containers, transformers, mtl, utf8-string, time, old-locale, X11, cairo, pango, unix
   exposed-modules:   Phi.Types, Phi.Phi, Phi.Panel, Phi.Widget, Phi.Border, Phi.X11,
                      Phi.Widgets.AlphaBox, Phi.Widgets.Clock, Phi.Widgets.Taskbar, Phi.Widgets.Systray
-  other-modules:     Phi.X11.Atoms, Phi.X11.AtomList, Phi.Bindings.Util
+  other-modules:     Phi.X11.Atoms, Phi.X11.AtomList, Phi.Bindings.Util, Phi.Bindings.SystrayErrorHandler
+  c-sources:         csrc/SystrayErrorHandler.c
+  include-dirs:      include
   hs-source-dirs:    lib
   extra-libraries:   X11
   pkgconfig-depends: cairo >= 1.2.0, cairo-xlib