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

Gracefully shut down systray

Browse source
This commit is contained in:
Matthias Schiffer 2011-07-19 12:25:08 +02:00
parent 19c4bb3521
commit 387613b2f0
5 changed files with 103 additions and 46 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -92,45 +92,59 @@ systrayRunner phi dispvar = do
initSuccess <- withDisplay dispvar $ flip initSystray atoms
case initSuccess of
Just xembedWindow -> flip evalStateT M.empty $ forever $ do
m <- receiveMessage phi
case (fromMessage m) of
Just event ->
handleEvent event phi dispvar xembedWindow
_ ->
case (fromMessage m) of
Just (RenderIcon midParent window x y w h reset) -> do
errorWindowRef <- liftIO $ newIORef []
withDisplay dispvar $ \disp -> do
liftIO $ do
sync disp False
setErrorHandler $ \disp eventptr -> do
event <- getErrorEvent eventptr
when (ev_error_code event == fromIntegral badWindow) $ do
errorWindows <- readIORef errorWindowRef
writeIORef errorWindowRef (ev_resourceid event:errorWindows)
(_, x', y', w', h', _, _) <- liftIO $ getGeometry disp midParent
let resize = (fromIntegral x) /= x' || (fromIntegral y) /= y' || (fromIntegral w) /= w' || (fromIntegral h) /= h'
Just xembedWindow -> flip evalStateT M.empty $ do
sendMessage phi HoldShutdown
forever $ do
m <- receiveMessage phi
case (fromMessage m) of
Just event ->
handleEvent event phi dispvar xembedWindow
_ ->
case (fromMessage m) of
Just (RenderIcon midParent window x y w h reset) -> do
errorWindowRef <- liftIO $ newIORef []
when resize $ liftIO $ do
moveResizeWindow disp midParent (fromIntegral x) (fromIntegral y) (fromIntegral w) (fromIntegral h)
resizeWindow disp window (fromIntegral w) (fromIntegral h)
liftIO $ sync disp False
when (resize || reset) $ liftIO $ do
clearArea disp midParent 0 0 (fromIntegral w) (fromIntegral h) True
liftIO $ sync disp False
clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True
liftIO $ sync disp False
liftIO $ xSetErrorHandler
errorWindows <- liftIO $ readIORef errorWindowRef
mapM_ (removeIcon phi disp) errorWindows
_ ->
return ()
withDisplay dispvar $ \disp -> do
liftIO $ flip catch (\_ -> return ()) $ do
sync disp False
setErrorHandler $ \disp eventptr -> do
event <- getErrorEvent eventptr
when (ev_error_code event == fromIntegral badWindow) $ do
errorWindows <- readIORef errorWindowRef
writeIORef errorWindowRef (ev_resourceid event:errorWindows)
(_, x', y', w', h', _, _) <- getGeometry disp midParent
let resize = (fromIntegral x) /= x' || (fromIntegral y) /= 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)
sync disp False
clearArea disp midParent 0 0 (fromIntegral w) (fromIntegral h) True
sync disp False
when (resize || reset) $ do
clearArea disp window 0 0 (fromIntegral w) (fromIntegral h) True
sync disp False
xSetErrorHandler
errorWindows <- liftIO $ readIORef errorWindowRef
mapM_ (removeIcon phi disp) errorWindows
_ ->
case (fromMessage m) of
Just Shutdown -> do
windows <- gets M.keys
withDisplay dispvar $ \disp -> do
mapM_ (removeIcon phi disp) windows
liftIO $ do
destroyWindow disp xembedWindow
sync disp False
sendMessage phi ReleaseShutdown
_ ->
return ()
Nothing ->
return ()
@ -265,8 +279,12 @@ removeIcon phi disp window = do
sendMessage phi $ RemoveIcon window
sendMessage phi Repaint
liftIO $ do
selectInput disp window $ noEventMask
unmapWindow disp window
reparentWindow disp window (defaultRootWindow disp) 0 0
destroyWindow disp midParent
sync disp False
modify $ M.delete window
_ ->
return ()

2
lib/Phi/Widgets/Taskbar.hs
View file

@ -530,7 +530,7 @@ premultiply c = a .|. r .|. g .|. b
getWindowScreen :: Xlib.Display -> [Xlib.Rectangle] -> Window -> IO Xlib.Rectangle
getWindowScreen disp screens window = do
getWindowScreen disp screens window = flip catch (\_ -> return $ head screens) $ do
(_, _, _, width, height, _, _) <- Xlib.getGeometry disp window
(ret, x, y, _) <- Xlib.translateCoordinates disp window (Xlib.defaultRootWindow disp) 0 0