[htoolkit-cvs] port/src/Port Handlers.hs,1.17,1.18 Menu.hs,1.5,1.6

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

Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv606/port/src/Port

Modified Files:
	Handlers.hs Menu.hs 
Log Message:
Implementation for SDI/MDI menu


Index: Handlers.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v
retrieving revision 1.17
retrieving revision 1.18
diff -C2 -d -r1.17 -r1.18
*** Handlers.hs	31 Mar 2003 00:12:06 -0000	1.17
--- Handlers.hs	1 Apr 2003 23:54:20 -0000	1.18
***************
*** 59,67 ****
                  -- * Control commands
                  ,setControlCommandHandler, setControlCommandDefHandler, getControlCommandHandler
!                 
!                 -- * Menus
!                 ,registerWindowMenu
!                 ,unregisterWindowMenus
!                 
                  -- ** Register commands
                  ,setMenuCommandHandler, setMenuCommandDefHandler, getMenuCommandHandler
--- 59,63 ----
                  -- * Control commands
                  ,setControlCommandHandler, setControlCommandDefHandler, getControlCommandHandler
! 
                  -- ** Register commands
                  ,setMenuCommandHandler, setMenuCommandDefHandler, getMenuCommandHandler
***************
*** 132,160 ****
          setWindowActivateDefHandler hwnd 
          setControlCommandDefHandler  hwnd
-         unregisterWindowMenus hwnd  -- unregister all menu command handlers
          return ()
- 
- {-----------------------------------------------------------------------------------------
-   Keep track of menu event handlers associated with a window
- -----------------------------------------------------------------------------------------}
- {-# NOINLINE windowMenus #-}
- windowMenus :: MVar (PtrMap WindowHandle [MenuHandle])
- windowMenus
-   = unsafePerformIO (newMVar empty)
- 
- -- | 'registerWindowMenu' should be called for each menu item associated with some window. This
- -- will automatically unregister any menu command handlers when the window is destroyed.
- registerWindowMenu :: WindowHandle -> MenuHandle -> IO ()
- registerWindowMenu hwnd hmenu
-   = do map <- takeMVar windowMenus
-        putMVar windowMenus (insertWith (++) hwnd [hmenu] map)
- 
- unregisterWindowMenus :: WindowHandle -> IO ()
- unregisterWindowMenus hwnd
-   = do map <- takeMVar windowMenus
-        case lookup hwnd map of
-          Nothing      -> putMVar windowMenus map
-          Just menus   -> do putMVar windowMenus (delete hwnd map)
-                             mapM_ setMenuCommandDefHandler menus
  
  {-----------------------------------------------------------------------------------------
--- 128,132 ----

Index: Menu.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Menu.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -C2 -d -r1.5 -r1.6
*** Menu.hs	26 Mar 2003 13:03:49 -0000	1.5
--- Menu.hs	1 Apr 2003 23:54:20 -0000	1.6
***************
*** 15,22 ****
             ( 
             -- * Menu bar
!              createMenuBar
             , drawMenuBar
             -- * Sub menus
!            , addSubMenu
             -- * Menu items
             , addMenuItem
--- 15,22 ----
             ( 
             -- * Menu bar
!              mainMenu
             , drawMenuBar
             -- * Sub menus
!            , addMenu
             -- * Menu items
             , addMenuItem
***************
*** 39,54 ****
  foreign import ccall "osDrawMenuBar" drawMenuBar :: WindowHandle -> IO ()
  
! -- | Create a (top level) menu bar.
! createMenuBar :: WindowHandle -> IO MenuHandle
! createMenuBar hwnd
!   = osCreateMenuBar hwnd
! foreign import ccall osCreateMenuBar :: WindowHandle -> IO MenuHandle
  
  -- | Add a sub menu.
! addSubMenu :: MenuHandle -> String -> IO MenuHandle
! addSubMenu hmenu title
!   = withCString title $ \ctitle ->
!     osAddSubMenu hmenu ctitle
! foreign import ccall osAddSubMenu    :: MenuHandle -> CString -> IO MenuHandle
  
  -- | Add a menu item. Use a null character ('keyNull') if no
--- 39,50 ----
  foreign import ccall "osDrawMenuBar" drawMenuBar :: WindowHandle -> IO ()
  
! -- | The handle of the main application menu
! mainMenu :: MenuHandle
! mainMenu = nullHandle
  
  -- | Add a sub menu.
! addMenu :: MenuHandle -> String -> IO MenuHandle
! addMenu hmenu title = withCString title (osAddMenu hmenu)
! foreign import ccall osAddMenu    :: MenuHandle -> CString -> IO MenuHandle
  
  -- | Add a menu item. Use a null character ('keyNull') if no