summaryrefslogtreecommitdiffstats
path: root/lib
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-07-19 14:50:04 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-07-19 14:50:04 +0200
commit227cf56f443d1ce45fce2e13a4daf442a29bc862 (patch)
tree0d53ff45098d54e49099aa45afc992ffc4c0fd63 /lib
parentbc9f8e1fbc7e117ec5368d2d74742cdb2c5f22f7 (diff)
downloadphi-227cf56f443d1ce45fce2e13a4daf442a29bc862.tar
phi-227cf56f443d1ce45fce2e13a4daf442a29bc862.zip
Add native error handler for systray
Diffstat (limited to 'lib')
-rw-r--r--lib/Phi/Bindings/SystrayErrorHandler.hsc17
-rw-r--r--lib/Phi/Widgets/Systray.hs38
-rw-r--r--lib/Phi/X11.hs2
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