summaryrefslogtreecommitdiffstats
path: root/lib/Phi/Widgets
diff options
context:
space:
mode:
authorMatthias Schiffer <mschiffer@universe-factory.net>2011-08-11 18:53:02 +0200
committerMatthias Schiffer <mschiffer@universe-factory.net>2011-08-11 18:53:02 +0200
commit8dab9ed128f5a7f80917d1eb90eed902e1a333b6 (patch)
tree6b0db5c5248a82846b80058baa6d55b50c6dbf14 /lib/Phi/Widgets
parentde1dc32b330d7362a18bdb61e11a146e0f316602 (diff)
downloadphi-8dab9ed128f5a7f80917d1eb90eed902e1a333b6.tar
phi-8dab9ed128f5a7f80917d1eb90eed902e1a333b6.zip
Some systray optimizations
Diffstat (limited to 'lib/Phi/Widgets')
-rw-r--r--lib/Phi/Widgets/Systray.hs47
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