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

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

@ -15,6 +15,9 @@ import Data.Typeable
import qualified Data.Map as M import qualified Data.Map as M
import Foreign.C.Types import Foreign.C.Types
import Foreign.Marshal
import Foreign.Ptr
import Foreign.Storable
import Graphics.Rendering.Cairo import Graphics.Rendering.Cairo
import Graphics.Rendering.Cairo.Types import Graphics.Rendering.Cairo.Types
@ -110,30 +113,30 @@ systrayRunner phi dispvar = do
setSystrayErrorHandler setSystrayErrorHandler
(_, x', y', w', h', _, _) <- getGeometry disp midParent (_, 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' 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 when resize $ do
moveResizeWindow disp midParent (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h) 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 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 sync disp False
xSetErrorHandler xSetErrorHandler
lastErrorWindow <- liftIO $ getLastErrorWindow lastErrorWindow <- liftIO $ getLastErrorWindow
when (lastErrorWindow == window) $ do when (lastErrorWindow == window) $ do
liftIO $ print window removeIcon phi disp True window
removeIcon phi disp window
_ -> _ ->
case (fromMessage m) of case (fromMessage m) of
Just Shutdown -> do Just Shutdown -> do
windows <- gets M.keys windows <- gets M.keys
withDisplay dispvar $ \disp -> do withDisplay dispvar $ \disp -> do
mapM_ (removeIcon phi disp) windows mapM_ (removeIcon phi disp True) windows
liftIO $ do liftIO $ do
destroyWindow disp xembedWindow destroyWindow disp xembedWindow
sync disp False sync disp False
@ -218,16 +221,34 @@ handleEvent message@ClientMessageEvent { ev_message_type = message_type, ev_data
return () return ()
handleEvent message@UnmapEvent { ev_window = window } phi dispvar xembedWindow = 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 = 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 () handleEvent _ _ _ _ = return ()
addIcon :: Phi -> Xlib.Display -> Atoms -> Window -> Window -> StateT (M.Map Window Window) IO () addIcon :: Phi -> Xlib.Display -> Atoms -> Window -> Window -> StateT (M.Map Window Window) IO ()
addIcon phi disp atoms panelWindow window = do addIcon phi disp atoms panelWindow window = do
removeIcon phi disp False window
liftIO $ selectInput disp window $ structureNotifyMask .|. propertyChangeMask liftIO $ selectInput disp window $ structureNotifyMask .|. propertyChangeMask
midParent <- liftIO $ createSimpleWindow disp panelWindow (-16) (-16) 16 16 0 0 0 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 liftIO $ destroyWindow disp midParent
removeIcon :: Phi -> Xlib.Display -> Window -> StateT (M.Map Window Window) IO () removeIcon :: Phi -> Xlib.Display -> Bool -> Window -> StateT (M.Map Window Window) IO ()
removeIcon phi disp window = do removeIcon phi disp reparent window = do
mmidParent <- gets $ M.lookup window mmidParent <- gets $ M.lookup window
case mmidParent of case mmidParent of
Just midParent -> do Just midParent -> do
@ -269,8 +290,8 @@ removeIcon phi disp window = do
sendMessage phi Repaint sendMessage phi Repaint
liftIO $ do liftIO $ do
selectInput disp window $ noEventMask selectInput disp window $ noEventMask
unmapWindow disp window when reparent $
reparentWindow disp window (defaultRootWindow disp) 0 0 reparentWindow disp window (defaultRootWindow disp) 0 0
destroyWindow disp midParent destroyWindow disp midParent
sync disp False sync disp False
modify $ M.delete window modify $ M.delete window