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
|
