neocturne/phi
Archived
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Some systray optimizations

Browse source
This commit is contained in:
Matthias Schiffer 2011-08-11 18:53:02 +02:00
parent de1dc32b33
commit 8dab9ed128
1 changed files with 34 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

43
lib/Phi/Widgets/Systray.hs
View file

@ -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,15 +113,16 @@ 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
when (resize || reset) $
clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True
sync disp False
@ -126,14 +130,13 @@ systrayRunner phi dispvar = do
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,7 +290,7 @@ removeIcon phi disp window = do
sendMessage phi Repaint
liftIO $ do
selectInput disp window $ noEventMask
unmapWindow disp window
when reparent $
reparentWindow disp window (defaultRootWindow disp) 0 0
destroyWindow disp midParent
sync disp False