From 387613b2f0752836524ccd6d9d8001694bd219fb Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Tue, 19 Jul 2011 12:25:08 +0200
Subject: Gracefully shut down systray

---
 lib/Phi/Widgets/Systray.hs | 94 +++++++++++++++++++++++++++-------------------
 lib/Phi/Widgets/Taskbar.hs |  2 +-
 2 files changed, 57 insertions(+), 39 deletions(-)

(limited to 'lib/Phi/Widgets')

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
   
-- 
cgit v1.2.3