[htoolkit-cvs] port/src/Port Handlers.hs,1.24,1.25 Menu.hs,1.7,1.8 ToolBar.hs,1.1,1.2

[<kr_...@us...>]

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 ----