Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv26496/src/Port
Modified Files:
Handlers.hs Menu.hs ToolBar.hs
Log Message:
fix: The bitmaps associated with Tool and Menu items needs to be freed when the item is destroied
Index: Handlers.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v
retrieving revision 1.24
retrieving revision 1.25
diff -C2 -d -r1.24 -r1.25
*** Handlers.hs 8 Jul 2003 20:31:29 -0000 1.24
--- Handlers.hs 8 Jul 2003 21:44:49 -0000 1.25
***************
*** 68,75 ****
--- 68,79 ----
,setMenuUpdateHandler, setMenuUpdateDefHandler, getMenuUpdateHandler
,setMenuDestroyHandler, setMenuDestroyDefHandler, getMenuDestroyHandler
+ -- ** Internals
+ ,menuBitmaps
-- * ToolBar events
,setToolCommandHandler, setToolCommandDefHandler, getToolCommandHandler
,setToolDestroyHandler, setToolDestroyDefHandler, getToolDestroyHandler
+ -- ** Internals
+ ,toolBitmaps
) where
***************
*** 543,546 ****
--- 547,554 ----
-----------------------------------------------------------------------------------------
+ {-# NOINLINE menuBitmaps #-}
+ menuBitmaps :: MVar (PtrMap MenuHandle Bitmap)
+ menuBitmaps = unsafePerformIO (newMVar empty)
+
{-# NOINLINE handlersMenuDestroy #-}
handlersMenuDestroy :: MVar (PtrMap MenuHandle (IO ()))
***************
*** 563,566 ****
--- 571,576 ----
handleMenuDestroy hmenu
= do map <- takeMVar handlersMenuDestroy
+ bmps <- takeMVar toolBitmaps
+ putMVar toolBitmaps (delete hmenu bmps)
setMenuCommandDefHandler hmenu
setMenuUpdateDefHandler hmenu
***************
*** 728,731 ****
--- 738,745 ----
-----------------------------------------------------------------------------------------
+ {-# NOINLINE toolBitmaps #-}
+ toolBitmaps :: MVar (PtrMap WindowHandle Bitmap)
+ toolBitmaps = unsafePerformIO (newMVar empty)
+
{-# NOINLINE handlersToolDestroy #-}
handlersToolDestroy :: MVar (PtrMap ToolHandle (IO ()))
***************
*** 748,751 ****
--- 762,767 ----
handleToolDestroy htool
= do map <- takeMVar handlersToolDestroy
+ bmps <- takeMVar toolBitmaps
+ putMVar toolBitmaps (delete htool bmps)
setToolCommandDefHandler htool
putMVar handlersToolDestroy (delete htool map)
Index: Menu.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Menu.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Menu.hs 23 Apr 2003 21:48:49 -0000 1.7
--- Menu.hs 8 Jul 2003 21:44:49 -0000 1.8
***************
*** 42,46 ****
import Control.Concurrent.MVar
import Graphics.UI.Port.Types
! import Graphics.UI.Port.Handlers -- just for haddock
import Graphics.UI.Port.PtrMap as PtrMap
import System.IO.Unsafe( unsafePerformIO )
--- 42,46 ----
import Control.Concurrent.MVar
import Graphics.UI.Port.Types
! import Graphics.UI.Port.Handlers
import Graphics.UI.Port.PtrMap as PtrMap
import System.IO.Unsafe( unsafePerformIO )
***************
*** 115,122 ****
-- | returns True if the menu item is checked.
foreign import ccall "osGetMenuItemChecked" getMenuItemChecked :: MenuHandle -> IO Bool
-
- {-# NOINLINE menuBitmaps #-}
- menuBitmaps :: MVar (PtrMap MenuHandle Bitmap)
- menuBitmaps = unsafePerformIO (newMVar empty)
setMenuItemBitmap :: MenuHandle -> Maybe Bitmap -> IO ()
--- 115,118 ----
Index: ToolBar.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/ToolBar.hs,v
retrieving revision 1.1
retrieving revision 1.2
diff -C2 -d -r1.1 -r1.2
*** ToolBar.hs 8 Jul 2003 20:31:29 -0000 1.1
--- ToolBar.hs 8 Jul 2003 21:44:49 -0000 1.2
***************
*** 32,35 ****
--- 32,36 ----
import Graphics.UI.Port.Types
+ import Graphics.UI.Port.Handlers
import Graphics.UI.Port.PtrMap as PtrMap
import Foreign.Ptr
***************
*** 65,72 ****
insertToolLine toolBar pos = osInsertToolLine toolBar (fromMaybe (-1) pos)
foreign import ccall osInsertToolLine :: WindowHandle -> Int -> IO ToolHandle
-
- {-# NOINLINE toolBitmaps #-}
- toolBitmaps :: MVar (PtrMap WindowHandle Bitmap)
- toolBitmaps = unsafePerformIO (newMVar empty)
setToolButtonBitmap :: ToolHandle -> Maybe Bitmap -> IO ()
--- 66,69 ----
|
