summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-07-19 12:25:08 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-07-19 12:25:08 +0200
commit387613b2f0752836524ccd6d9d8001694bd219fb (patch)
tree7975b133db20a36865eff4f5b1e90415d963b023 /lib/Phi/Widgets
parent19c4bb35212b422ce0c3d8808357e0edf8728218 (diff)
downloadphi-387613b2f0752836524ccd6d9d8001694bd219fb.tar
phi-387613b2f0752836524ccd6d9d8001694bd219fb.zip
Gracefully shut down systray
Diffstat (limited to 'lib/Phi/Widgets')
-rw-r--r--lib/Phi/Widgets/Systray.hs94
-rw-r--r--lib/Phi/Widgets/Taskbar.hs2
2 files changed, 57 insertions, 39 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 ()
diff --git a/lib/Phi/Widgets/Taskbar.hs b/lib/Phi/Widgets/Taskbar.hs
index f8b61f0..24f6611 100644
--- a/lib/Phi/Widgets/Taskbar.hs
+++ b/lib/Phi/Widgets/Taskbar.hs
@@ -530,7 +530,7 @@ premultiply c = a .|. r .|. g .|. b
getWindowScreen :: Xlib.Display -> [Xlib.Rectangle] -> Window -> IO Xlib.Rectangle
-getWindowScreen disp screens window = do
+getWindowScreen disp screens window = flip catch (\_ -> return $ head screens) $ do
(_, _, _, width, height, _, _) <- Xlib.getGeometry disp window
(ret, x, y, _) <- Xlib.translateCoordinates disp window (Xlib.defaultRootWindow disp) 0 0