|
From: <kr_...@us...> - 2003-03-31 00:12:10
|
Update of /cvsroot/htoolkit/port/src/Port
In directory sc8-pr-cvs1:/tmp/cvs-serv21987/port/src/Port
Modified Files:
Handlers.hs Types.hs Window.hs
Log Message:
implementation for contextMenu event
Index: Handlers.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Handlers.hs,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** Handlers.hs 26 Mar 2003 08:45:52 -0000 1.16
--- Handlers.hs 31 Mar 2003 00:12:06 -0000 1.17
***************
*** 38,51 ****
-- ** Events
! ,setWindowReLayoutHandler, setWindowReLayoutDefHandler, getWindowReLayoutHandler
! ,setWindowDismissHandler, setWindowDismissDefHandler, getWindowDismissHandler
! ,setWindowDestroyHandler, setWindowDestroyDefHandler, getWindowDestroyHandler
! ,setWindowPaintHandler, setWindowPaintDefHandler, getWindowPaintHandler
! ,setWindowResizeHandler, setWindowResizeDefHandler, getWindowResizeHandler
! ,setWindowScrollHandler, setWindowScrollDefHandler, getWindowScrollHandler
! ,setWindowMouseHandler, setWindowMouseDefHandler, getWindowMouseHandler
! ,setWindowKeyboardHandler, setWindowKeyboardDefHandler, getWindowKeyboardHandler
! ,setWindowActivateHandler, setWindowActivateDefHandler, getWindowActivateHandler
! ,setWindowDeactivateHandler,setWindowDeactivateDefHandler,getWindowDeactivateHandler
-- ** Fire events
--- 38,52 ----
-- ** Events
! ,setWindowReLayoutHandler, setWindowReLayoutDefHandler, getWindowReLayoutHandler
! ,setWindowDismissHandler, setWindowDismissDefHandler, getWindowDismissHandler
! ,setWindowDestroyHandler, setWindowDestroyDefHandler, getWindowDestroyHandler
! ,setWindowPaintHandler, setWindowPaintDefHandler, getWindowPaintHandler
! ,setWindowResizeHandler, setWindowResizeDefHandler, getWindowResizeHandler
! ,setWindowScrollHandler, setWindowScrollDefHandler, getWindowScrollHandler
! ,setWindowMouseHandler, setWindowMouseDefHandler, getWindowMouseHandler
! ,setWindowKeyboardHandler, setWindowKeyboardDefHandler, getWindowKeyboardHandler
! ,setWindowActivateHandler, setWindowActivateDefHandler, getWindowActivateHandler
! ,setWindowDeactivateHandler, setWindowDeactivateDefHandler, getWindowDeactivateHandler
! ,setWindowContextMenuHandler,setWindowContextMenuDefHandler,getWindowContextMenuHandler
-- ** Fire events
***************
*** 475,478 ****
--- 476,504 ----
-----------------------------------------------------------------------------------------
+ -- WindowContextMenu
+ -----------------------------------------------------------------------------------------
+
+ {-# NOINLINE handlersWindowContextMenu #-}
+ handlersWindowContextMenu :: MVar (PtrMap WindowHandle (Point -> Modifiers -> IO ()))
+ handlersWindowContextMenu
+ = unsafePerformIO (newMVar empty)
+
+ setWindowContextMenuHandler :: WindowHandle -> (Point -> Modifiers -> IO ()) -> IO ()
+ setWindowContextMenuHandler hwnd handler
+ = setHandler hwnd handler handlersWindowContextMenu
+
+ setWindowContextMenuDefHandler :: WindowHandle -> IO ()
+ setWindowContextMenuDefHandler hwnd
+ = setDefHandler hwnd handlersWindowContextMenu
+
+ getWindowContextMenuHandler :: WindowHandle -> IO (Point -> Modifiers -> IO ())
+ getWindowContextMenuHandler hwnd
+ = getHandler hwnd (\p m -> return ()) handlersWindowContextMenu
+
+ handleWindowContextMenu :: WindowHandle -> CInt -> CInt -> CWord -> IO ()
+ handleWindowContextMenu hwnd cx cy cmods
+ = invokeHandler hwnd handlersWindowContextMenu (\f -> f (fromCPoint cx cy) (fromCModifiers cmods))
+
+ -----------------------------------------------------------------------------------------
-- MenuUpdate
-----------------------------------------------------------------------------------------
***************
*** 617,620 ****
--- 643,647 ----
foreign export ccall handleWindowDeactivate :: WindowHandle -> IO ()
foreign export ccall handleWindowActivate :: WindowHandle -> IO ()
+ foreign export ccall handleWindowContextMenu :: WindowHandle -> CInt -> CInt -> CWord -> IO ()
foreign export ccall handleControlCommand :: WindowHandle -> IO ()
foreign export ccall handleMenuCommand :: MenuHandle -> IO ()
Index: Types.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Types.hs,v
retrieving revision 1.16
retrieving revision 1.17
diff -C2 -d -r1.16 -r1.17
*** Types.hs 26 Mar 2003 18:20:35 -0000 1.16
--- Types.hs 31 Mar 2003 00:12:06 -0000 1.17
***************
*** 98,102 ****
, withCSize, withCSizeResult, fromCSize
, withCRect, withCRectResult, fromCRect
!
, fromCKey, toCKey
, fromCMouseEvent
--- 98,103 ----
, withCSize, withCSizeResult, fromCSize
, withCRect, withCRectResult, fromCRect
!
! , fromCModifiers, toCModifiers
, fromCKey, toCKey
, fromCMouseEvent
Index: Window.hs
===================================================================
RCS file: /cvsroot/htoolkit/port/src/Port/Window.hs,v
retrieving revision 1.7
retrieving revision 1.8
diff -C2 -d -r1.7 -r1.8
*** Window.hs 26 Mar 2003 15:39:48 -0000 1.7
--- Window.hs 31 Mar 2003 00:12:06 -0000 1.8
***************
*** 43,46 ****
--- 43,47 ----
import System.IO.Unsafe( unsafePerformIO )
import Control.Concurrent.MVar
+ import Control.Monad(when)
import Graphics.UI.Port.PtrMap
import Graphics.UI.Port.Types
***************
*** 79,82 ****
--- 80,84 ----
createWindow = do
hwnd <- osCreateWindow
+ when (hwnd == nullHandle) (ioError (userError "Window.createWindow can't create more windows."))
registerWindow hwnd
setWindowPaintHandler hwnd onpaint
|