summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets/Systray.hs
diff options
context:
space:
mode:
Diffstat (limited to 'lib/Phi/Widgets/Systray.hs')
-rw-r--r--lib/Phi/Widgets/Systray.hs94
1 files changed, 56 insertions, 38 deletions
diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs
index 3d3c38b..e11e58d 100644
--- a/lib/Phi/Widgets/Systray.hs
+++ b/lib/Phi/Widgets/Systray.hs
@@ -92,45 +92,59 @@ systrayRunner phi dispvar = do
initSuccess <- withDisplay dispvar $ flip initSystray atoms
case initSuccess of
- Just xembedWindow -> flip evalStateT M.empty $ forever $ do
- m <- receiveMessage phi
- case (fromMessage m) of
- Just event ->
- handleEvent event phi dispvar xembedWindow
- _ ->
- case (fromMessage m) of
- Just (RenderIcon midParent window x y w h reset) -> do
- errorWindowRef <- liftIO $ newIORef []
-
- withDisplay dispvar $ \disp -> do
- liftIO $ 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)
-
- (_, x', y', w', h', _, _) <- liftIO $ getGeometry disp midParent
- let resize = (fromIntegral x) /= x' || (fromIntegral y) /= y' || (fromIntegral w) /= w' || (fromIntegral h) /= h'
-
- when resize $ liftIO $ do
- moveResizeWindow disp midParent (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
- resizeWindow disp window (fromIntegral w) (fromIntegral h)
- liftIO $ sync disp False
-
- when (resize || reset) $ liftIO $ do
- clearArea disp midParent 0 0 (fromIntegral w) (fromIntegral h) True
- liftIO $ sync disp False
- clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True
- liftIO $ sync disp False
-
- liftIO $ xSetErrorHandler
+ Just xembedWindow -> flip evalStateT M.empty $ do
+ sendMessage phi HoldShutdown
+
+ forever $ do
+ m <- receiveMessage phi
+ case (fromMessage m) of
+ Just event ->
+ handleEvent event phi dispvar xembedWindow
+ _ ->
+ case (fromMessage m) of
+ Just (RenderIcon midParent window x y w h reset) -> do
+ errorWindowRef <- liftIO $ newIORef []
- errorWindows <- liftIO $ readIORef errorWindowRef
- mapM_ (removeIcon phi disp) errorWindows
- _ ->
- return ()
+ 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)
+
+ (_, x', y', w', h', _, _) <- getGeometry disp midParent
+ let resize = (fromIntegral x) /= x' || (fromIntegral y) /= y' || (fromIntegral w) /= w' || (fromIntegral h) /= h'
+
+ when resize $ do
+ moveResizeWindow disp midParent (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
+ resizeWindow disp window (fromIntegral w) (fromIntegral h)
+ sync disp False
+
+ clearArea disp midParent 0 0 (fromIntegral w) (fromIntegral h) True
+ sync disp False
+
+ when (resize || reset) $ do
+ clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True
+ sync disp False
+
+ xSetErrorHandler
+
+ errorWindows <- liftIO $ readIORef errorWindowRef
+ mapM_ (removeIcon phi disp) errorWindows
+ _ ->
+ case (fromMessage m) of
+ Just Shutdown -> do
+ windows <- gets M.keys
+ withDisplay dispvar $ \disp -> do
+ mapM_ (removeIcon phi disp) windows
+ liftIO $ do
+ destroyWindow disp xembedWindow
+ sync disp False
+ sendMessage phi ReleaseShutdown
+ _ ->
+ return ()
Nothing ->
return ()
@@ -265,8 +279,12 @@ removeIcon phi disp window = do
sendMessage phi $ RemoveIcon window
sendMessage phi Repaint
liftIO $ do
+ selectInput disp window $ noEventMask
+ unmapWindow disp window
reparentWindow disp window (defaultRootWindow disp) 0 0
destroyWindow disp midParent
+ sync disp False
+ modify $ M.delete window
_ ->
return ()