From 8dab9ed128f5a7f80917d1eb90eed902e1a333b6 Mon Sep 17 00:00:00 2001
From: Matthias Schiffer <mschiffer@universe-factory.net>
Date: Thu, 11 Aug 2011 18:53:02 +0200
Subject: Some systray optimizations

---
 lib/Phi/Widgets/Systray.hs | 47 +++++++++++++++++++++++++++++++++-------------
 1 file changed, 34 insertions(+), 13 deletions(-)

(limited to 'lib/Phi/Widgets')

diff --git a/lib/Phi/Widgets/Systray.hs b/lib/Phi/Widgets/Systray.hs
index 2f8de56..60cfd76 100644
--- a/lib/Phi/Widgets/Systray.hs
+++ b/lib/Phi/Widgets/Systray.hs
@@ -15,6 +15,9 @@ import Data.Typeable
 import qualified Data.Map as M
 
 import Foreign.C.Types
+import Foreign.Marshal
+import Foreign.Ptr
+import Foreign.Storable
 
 import Graphics.Rendering.Cairo
 import Graphics.Rendering.Cairo.Types
@@ -110,30 +113,30 @@ systrayRunner phi dispvar = do
                     setSystrayErrorHandler
                     
                     (_, x', y', w', h', _, _) <- getGeometry disp midParent
-                    (_, _, _, w'', h'', _, _) <- getGeometry disp window
+                    (_, x'', y'', w'', h'', _, _) <- getGeometry disp window
                     let resize = (fromIntegral x) /= x' || (fromIntegral y) /= y' || (fromIntegral w) /= w' || (fromIntegral h) /= h'
-                                 || (fromIntegral w) /= w'' || (fromIntegral h) /= h''
+                                 || 0 /= x'' || 0 /= 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)
+                      moveResizeWindow disp window 0 0 (fromIntegral w) (fromIntegral h)
                       sync disp False
                     
-                    clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True
+                    when (resize || reset) $
+                      clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True
                       
                     sync disp False
                     xSetErrorHandler
                   
                   lastErrorWindow <- liftIO $ getLastErrorWindow
                   when (lastErrorWindow == window) $ do
-                    liftIO $ print window
-                    removeIcon phi disp window
+                    removeIcon phi disp True window
               _ ->
                 case (fromMessage m) of
                   Just Shutdown -> do
                     windows <- gets M.keys
                     withDisplay dispvar $ \disp -> do
-                      mapM_ (removeIcon phi disp) windows
+                      mapM_ (removeIcon phi disp True) windows
                       liftIO $ do
                         destroyWindow disp xembedWindow
                         sync disp False
@@ -218,16 +221,34 @@ handleEvent message@ClientMessageEvent { ev_message_type = message_type, ev_data
         return ()
 
 handleEvent message@UnmapEvent { ev_window = window } phi dispvar xembedWindow =
-  withDisplay dispvar $ flip (removeIcon phi) window
+  withDisplay dispvar $ \disp -> removeIcon phi disp True window
 
 handleEvent message@DestroyWindowEvent { ev_window = window } phi dispvar xembedWindow =
-  withDisplay dispvar $ flip (removeIcon phi) window
+  withDisplay dispvar $ \disp -> removeIcon phi disp False window
+
+handleEvent message@AnyEvent { ev_window = window } phi dispvar xembedWindow | ev_event_type message == reparentNotify = do
+  parent <- liftIO $ alloca $ \rootPtr -> alloca $ \parentPtr -> alloca $ \childrenPtrPtr -> alloca $ \nChildrenPtr -> do
+    status <- withDisplay dispvar $ \disp -> xQueryTree disp window rootPtr parentPtr childrenPtrPtr nChildrenPtr
+    case status of
+      0 ->
+        return 0
+      _ -> do
+        childrenPtr <- peek childrenPtrPtr
+        when (childrenPtr /= nullPtr) $
+          xFree childrenPtr >> return ()
+        peek parentPtr
+  midParent <- gets $ M.lookup window
+  when (midParent /= Just parent) $
+    withDisplay dispvar $ \disp -> removeIcon phi disp False window
+  return ()
 
 handleEvent _ _ _ _ = return ()
 
 
 addIcon :: Phi -> Xlib.Display -> Atoms -> Window -> Window -> StateT (M.Map Window Window) IO ()
 addIcon phi disp atoms panelWindow window = do
+  removeIcon phi disp False window
+  
   liftIO $ selectInput disp window $ structureNotifyMask .|. propertyChangeMask
   
   midParent <- liftIO $ createSimpleWindow disp panelWindow (-16) (-16) 16 16 0 0 0
@@ -260,8 +281,8 @@ addIcon phi disp atoms panelWindow window = do
       liftIO $ destroyWindow disp midParent
 
 
-removeIcon :: Phi -> Xlib.Display -> Window -> StateT (M.Map Window Window) IO ()
-removeIcon phi disp window = do
+removeIcon :: Phi -> Xlib.Display -> Bool -> Window -> StateT (M.Map Window Window) IO ()
+removeIcon phi disp reparent window = do
   mmidParent <- gets $ M.lookup window
   case mmidParent of
     Just midParent -> do
@@ -269,8 +290,8 @@ removeIcon phi disp window = do
       sendMessage phi Repaint
       liftIO $ do
         selectInput disp window $ noEventMask
-        unmapWindow disp window
-        reparentWindow disp window (defaultRootWindow disp) 0 0
+        when reparent $
+          reparentWindow disp window (defaultRootWindow disp) 0 0
         destroyWindow disp midParent
         sync disp False
       modify $ M.delete window
-- 
cgit v1.2.3