[[wxhaskell-from-cvs @ 2004-02-12 09:59:56 by dleijen]
dleijen**20040212095956
 Added wxHtml events.
] {
hunk ./wxcore/src/Graphics/UI/WXCore/Events.hs 54
+        , htmlWindowOnHtmlEvent
hunk ./wxcore/src/Graphics/UI/WXCore/Events.hs 62
+
hunk ./wxcore/src/Graphics/UI/WXCore/Events.hs 96
+        , htmlWindowGetOnHtmlEvent
hunk ./wxcore/src/Graphics/UI/WXCore/Events.hs 137
+
+        -- ** Html window events
+        , EventHtml(..)
hunk ./wxcore/src/Graphics/UI/WXCore/Events.hs 416
+{--------------------------------------------------------------------------
+  Html event
+--------------------------------------------------------------------------}
+-- | Html window events
+data EventHtml  
+  = HtmlCellClicked String EventMouse  Point 
+      -- ^ A /cell/ is clicked. Contains the cell /id/ attribute value, the mouse event and the logical coordinates.
+  | HtmlCellHover String 
+      -- ^ The mouse hovers over a cell. Contains the cell /id/ attribute value.
+  | HtmlLinkClicked String String String EventMouse 
+     -- ^ A link is clicked. Contains the hyperlink, the frame target, the cell /id/ attribute value, and the mouse event.
+  | HtmlSetTitle String
+     -- ^ Called when a @<title>@ tag is parsed.
+  | HtmlUnknown 
+     -- ^ Unrecognised html event
+
+instance Show EventHtml where
+  show ev
+    = case ev of
+        HtmlCellClicked id mouse pnt         -> "Html Cell " ++ show id ++ " clicked: " ++ show mouse
+        HtmlLinkClicked href target id mouse -> "Html Link " ++ show id ++ " clicked: " ++ href
+        HtmlCellHover id                     -> "Html Cell " ++ show id ++ " hover"
+        HtmlSetTitle title                   -> "Html event title: " ++ title
+        HtmlUnknown                          -> "Html event unknown"
+
+fromHtmlEvent :: WXCHtmlEvent a -> IO EventHtml
+fromHtmlEvent event
+  = do tp <- eventGetEventType event
+       case lookup tp htmlEvents of
+         Nothing      -> return HtmlUnknown 
+         Just action  -> action event
+  where
+    htmlEvents  = [(wxEVT_HTML_CELL_MOUSE_HOVER,  htmlHover)
+                  ,(wxEVT_HTML_CELL_CLICKED,      htmlClicked)
+                  ,(wxEVT_HTML_LINK_CLICKED,      htmlLink)
+                  ,(wxEVT_HTML_SET_TITLE,         htmlTitle)]
+
+    htmlTitle event
+      = do title <- commandEventGetString event
+           return (HtmlSetTitle title)
+
+    htmlHover event
+      = do id      <- wxcHtmlEventGetHtmlCellId event
+           return (HtmlCellHover id)
+
+    htmlClicked event
+      = do id      <- wxcHtmlEventGetHtmlCellId event
+           mouseEv <- wxcHtmlEventGetMouseEvent event
+           mouse   <- fromMouseEvent mouseEv
+           pnt     <- wxcHtmlEventGetLogicalPosition event
+           return (HtmlCellClicked id mouse pnt)
+
+    htmlLink event
+      = do id      <- wxcHtmlEventGetHtmlCellId event
+           mouseEv <- wxcHtmlEventGetMouseEvent event
+           mouse   <- fromMouseEvent mouseEv
+           href    <- wxcHtmlEventGetHref event
+           target  <- wxcHtmlEventGetTarget event
+           return (HtmlLinkClicked href target id mouse)
+      
+-- | Set a html event handler for a html window. The first argument determines whether
+-- hover events ('HtmlCellHover') are handled or not.
+htmlWindowOnHtmlEvent :: WXCHtmlWindow a -> Bool -> (EventHtml -> IO ()) -> IO ()
+htmlWindowOnHtmlEvent window allowHover handler
+  = windowOnEvent window htmlEvents handler eventHandler
+  where
+    htmlEvents
+      = [wxEVT_HTML_CELL_CLICKED,wxEVT_HTML_LINK_CLICKED,wxEVT_HTML_SET_TITLE]
+        ++ (if allowHover then [wxEVT_HTML_CELL_MOUSE_HOVER] else [])
+
+    eventHandler event
+      = do eventHtml <- fromHtmlEvent (objectCast event)
+           handler eventHtml
+
+-- | Get the current html event handler of a html window.
+htmlWindowGetOnHtmlEvent :: WXCHtmlWindow a -> IO (EventHtml -> IO ())
+htmlWindowGetOnHtmlEvent window
+  = unsafeWindowGetHandlerState window wxEVT_HTML_CELL_CLICKED (\ev -> skipCurrentEvent)
+
+     
+          
}