diff options
Diffstat (limited to 'lib/Phi/Widgets')
| -rw-r--r-- | lib/Phi/Widgets/Systray.hs | 47 |
1 files changed, 34 insertions, 13 deletions
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 |