{-# OPTIONS_HADDOCK hide #-} {-# LANGUAGE CPP #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell -- -- Author : Axel Simon -- -- Copyright (C) 2001-2005 Axel Simon -- -- This library is free software; you can redistribute it and/or -- modify it under the terms of the GNU Lesser General Public -- License as published by the Free Software Foundation; either -- version 2.1 of the License, or (at your option) any later version. -- -- This library is distributed in the hope that it will be useful, -- but WITHOUT ANY WARRANTY; without even the implied warranty of -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- Lesser General Public License for more details. -- -- #hide -- | -- Maintainer : gtk2hs-users@lists.sourceforge.net -- Stability : provisional -- Portability : portable (depends on GHC) -- -- This file reflects the Gtk+ object hierarchy in terms of Haskell classes. -- -- Note: the mk... functions were originally meant to simply be an alias -- for the constructor. However, in order to communicate the destructor -- of an object to objectNew, the mk... functions are now a tuple containing -- Haskell constructor and the destructor function pointer. This hack avoids -- changing all modules that simply pass mk... to objectNew. -- module Graphics.UI.Gtk.WebKit.Types ( module Graphics.UI.GtkInternals, WebView(WebView), WebViewClass, toWebView, mkWebView, unWebView, castToWebView, gTypeWebView, WebFrame(WebFrame), WebFrameClass, toWebFrame, mkWebFrame, unWebFrame, castToWebFrame, gTypeWebFrame, WebSettings(WebSettings), WebSettingsClass, toWebSettings, mkWebSettings, unWebSettings, castToWebSettings, gTypeWebSettings, NetworkRequest(NetworkRequest), NetworkRequestClass, toNetworkRequest, mkNetworkRequest, unNetworkRequest, castToNetworkRequest, gTypeNetworkRequest, NetworkResponse(NetworkResponse), NetworkResponseClass, toNetworkResponse, mkNetworkResponse, unNetworkResponse, castToNetworkResponse, gTypeNetworkResponse, Download(Download), DownloadClass, toDownload, mkDownload, unDownload, castToDownload, gTypeDownload, WebBackForwardList(WebBackForwardList), WebBackForwardListClass, toWebBackForwardList, mkWebBackForwardList, unWebBackForwardList, castToWebBackForwardList, gTypeWebBackForwardList, WebHistoryItem(WebHistoryItem), WebHistoryItemClass, toWebHistoryItem, mkWebHistoryItem, unWebHistoryItem, castToWebHistoryItem, gTypeWebHistoryItem, WebInspector(WebInspector), WebInspectorClass, toWebInspector, mkWebInspector, unWebInspector, castToWebInspector, gTypeWebInspector, HitTestResult(HitTestResult), HitTestResultClass, toHitTestResult, mkHitTestResult, unHitTestResult, castToHitTestResult, gTypeHitTestResult, SecurityOrigin(SecurityOrigin), SecurityOriginClass, toSecurityOrigin, mkSecurityOrigin, unSecurityOrigin, castToSecurityOrigin, gTypeSecurityOrigin, SoupAuthDialog(SoupAuthDialog), SoupAuthDialogClass, toSoupAuthDialog, mkSoupAuthDialog, unSoupAuthDialog, castToSoupAuthDialog, gTypeSoupAuthDialog, WebDatabase(WebDatabase), WebDatabaseClass, toWebDatabase, mkWebDatabase, unWebDatabase, castToWebDatabase, gTypeWebDatabase, WebDataSource(WebDataSource), WebDataSourceClass, toWebDataSource, mkWebDataSource, unWebDataSource, castToWebDataSource, gTypeWebDataSource, WebNavigationAction(WebNavigationAction), WebNavigationActionClass, toWebNavigationAction, mkWebNavigationAction, unWebNavigationAction, castToWebNavigationAction, gTypeWebNavigationAction, WebPolicyDecision(WebPolicyDecision), WebPolicyDecisionClass, toWebPolicyDecision, mkWebPolicyDecision, unWebPolicyDecision, castToWebPolicyDecision, gTypeWebPolicyDecision, WebResource(WebResource), WebResourceClass, toWebResource, mkWebResource, unWebResource, castToWebResource, gTypeWebResource, WebWindowFeatures(WebWindowFeatures), WebWindowFeaturesClass, toWebWindowFeatures, mkWebWindowFeatures, unWebWindowFeatures, castToWebWindowFeatures, gTypeWebWindowFeatures, GeolocationPolicyDecision(GeolocationPolicyDecision), GeolocationPolicyDecisionClass, toGeolocationPolicyDecision, mkGeolocationPolicyDecision, unGeolocationPolicyDecision, castToGeolocationPolicyDecision, gTypeGeolocationPolicyDecision ) where import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr) #if __GLASGOW_HASKELL__>=704 import Foreign.C.Types (CULong(..), CUInt(..)) #else import Foreign.C.Types (CULong, CUInt) #endif import System.Glib.GType (GType, typeInstanceIsA) {#import Graphics.UI.GtkInternals#} {# context lib="gtk" prefix="gtk" #} -- The usage of foreignPtrToPtr should be safe as the evaluation will only be -- forced if the object is used afterwards -- castTo :: (GObjectClass obj, GObjectClass obj') => GType -> String -> (obj -> obj') castTo gtype objTypeName obj = case toGObject obj of gobj@(GObject objFPtr) | typeInstanceIsA ((unsafeForeignPtrToPtr.castForeignPtr) objFPtr) gtype -> unsafeCastGObject gobj | otherwise -> error $ "Cannot cast object to " ++ objTypeName -- ******************************************************************** WebView {#pointer *WebKitWebView as WebView foreign newtype #} deriving (Eq,Ord) mkWebView = (WebView, objectUnrefFromMainloop) unWebView (WebView o) = o class ContainerClass o => WebViewClass o toWebView :: WebViewClass o => o -> WebView toWebView = unsafeCastGObject . toGObject instance WebViewClass WebView instance ContainerClass WebView instance WidgetClass WebView instance ObjectClass WebView instance GObjectClass WebView where toGObject = GObject . castForeignPtr . unWebView unsafeCastGObject = WebView . castForeignPtr . unGObject castToWebView :: GObjectClass obj => obj -> WebView castToWebView = castTo gTypeWebView "WebView" gTypeWebView :: GType gTypeWebView = {# call fun unsafe webkit_web_view_get_type #} -- ******************************************************************* WebFrame {#pointer *WebKitWebFrame as WebFrame foreign newtype #} deriving (Eq,Ord) mkWebFrame = (WebFrame, objectUnrefFromMainloop) unWebFrame (WebFrame o) = o class GObjectClass o => WebFrameClass o toWebFrame :: WebFrameClass o => o -> WebFrame toWebFrame = unsafeCastGObject . toGObject instance WebFrameClass WebFrame instance GObjectClass WebFrame where toGObject = GObject . castForeignPtr . unWebFrame unsafeCastGObject = WebFrame . castForeignPtr . unGObject castToWebFrame :: GObjectClass obj => obj -> WebFrame castToWebFrame = castTo gTypeWebFrame "WebFrame" gTypeWebFrame :: GType gTypeWebFrame = {# call fun unsafe webkit_web_frame_get_type #} -- **************************************************************** WebSettings {#pointer *WebKitWebSettings as WebSettings foreign newtype #} deriving (Eq,Ord) mkWebSettings = (WebSettings, objectUnrefFromMainloop) unWebSettings (WebSettings o) = o class GObjectClass o => WebSettingsClass o toWebSettings :: WebSettingsClass o => o -> WebSettings toWebSettings = unsafeCastGObject . toGObject instance WebSettingsClass WebSettings instance GObjectClass WebSettings where toGObject = GObject . castForeignPtr . unWebSettings unsafeCastGObject = WebSettings . castForeignPtr . unGObject castToWebSettings :: GObjectClass obj => obj -> WebSettings castToWebSettings = castTo gTypeWebSettings "WebSettings" gTypeWebSettings :: GType gTypeWebSettings = {# call fun unsafe webkit_web_settings_get_type #} -- ************************************************************* NetworkRequest {#pointer *WebKitNetworkRequest as NetworkRequest foreign newtype #} deriving (Eq,Ord) mkNetworkRequest = (NetworkRequest, objectUnrefFromMainloop) unNetworkRequest (NetworkRequest o) = o class GObjectClass o => NetworkRequestClass o toNetworkRequest :: NetworkRequestClass o => o -> NetworkRequest toNetworkRequest = unsafeCastGObject . toGObject instance NetworkRequestClass NetworkRequest instance GObjectClass NetworkRequest where toGObject = GObject . castForeignPtr . unNetworkRequest unsafeCastGObject = NetworkRequest . castForeignPtr . unGObject castToNetworkRequest :: GObjectClass obj => obj -> NetworkRequest castToNetworkRequest = castTo gTypeNetworkRequest "NetworkRequest" gTypeNetworkRequest :: GType gTypeNetworkRequest = {# call fun unsafe webkit_network_request_get_type #} -- ************************************************************ NetworkResponse {#pointer *WebKitNetworkResponse as NetworkResponse foreign newtype #} deriving (Eq,Ord) mkNetworkResponse = (NetworkResponse, objectUnrefFromMainloop) unNetworkResponse (NetworkResponse o) = o class GObjectClass o => NetworkResponseClass o toNetworkResponse :: NetworkResponseClass o => o -> NetworkResponse toNetworkResponse = unsafeCastGObject . toGObject instance NetworkResponseClass NetworkResponse instance GObjectClass NetworkResponse where toGObject = GObject . castForeignPtr . unNetworkResponse unsafeCastGObject = NetworkResponse . castForeignPtr . unGObject castToNetworkResponse :: GObjectClass obj => obj -> NetworkResponse castToNetworkResponse = castTo gTypeNetworkResponse "NetworkResponse" gTypeNetworkResponse :: GType gTypeNetworkResponse = {# call fun unsafe webkit_network_response_get_type #} -- ******************************************************************* Download {#pointer *WebKitDownload as Download foreign newtype #} deriving (Eq,Ord) mkDownload = (Download, objectUnrefFromMainloop) unDownload (Download o) = o class GObjectClass o => DownloadClass o toDownload :: DownloadClass o => o -> Download toDownload = unsafeCastGObject . toGObject instance DownloadClass Download instance GObjectClass Download where toGObject = GObject . castForeignPtr . unDownload unsafeCastGObject = Download . castForeignPtr . unGObject castToDownload :: GObjectClass obj => obj -> Download castToDownload = castTo gTypeDownload "Download" gTypeDownload :: GType gTypeDownload = {# call fun unsafe webkit_download_get_type #} -- ********************************************************* WebBackForwardList {#pointer *WebKitWebBackForwardList as WebBackForwardList foreign newtype #} deriving (Eq,Ord) mkWebBackForwardList = (WebBackForwardList, objectUnrefFromMainloop) unWebBackForwardList (WebBackForwardList o) = o class GObjectClass o => WebBackForwardListClass o toWebBackForwardList :: WebBackForwardListClass o => o -> WebBackForwardList toWebBackForwardList = unsafeCastGObject . toGObject instance WebBackForwardListClass WebBackForwardList instance GObjectClass WebBackForwardList where toGObject = GObject . castForeignPtr . unWebBackForwardList unsafeCastGObject = WebBackForwardList . castForeignPtr . unGObject castToWebBackForwardList :: GObjectClass obj => obj -> WebBackForwardList castToWebBackForwardList = castTo gTypeWebBackForwardList "WebBackForwardList" gTypeWebBackForwardList :: GType gTypeWebBackForwardList = {# call fun unsafe webkit_web_back_forward_list_get_type #} -- ************************************************************* WebHistoryItem {#pointer *WebKitWebHistoryItem as WebHistoryItem foreign newtype #} deriving (Eq,Ord) mkWebHistoryItem = (WebHistoryItem, objectUnrefFromMainloop) unWebHistoryItem (WebHistoryItem o) = o class GObjectClass o => WebHistoryItemClass o toWebHistoryItem :: WebHistoryItemClass o => o -> WebHistoryItem toWebHistoryItem = unsafeCastGObject . toGObject instance WebHistoryItemClass WebHistoryItem instance GObjectClass WebHistoryItem where toGObject = GObject . castForeignPtr . unWebHistoryItem unsafeCastGObject = WebHistoryItem . castForeignPtr . unGObject castToWebHistoryItem :: GObjectClass obj => obj -> WebHistoryItem castToWebHistoryItem = castTo gTypeWebHistoryItem "WebHistoryItem" gTypeWebHistoryItem :: GType gTypeWebHistoryItem = {# call fun unsafe webkit_web_history_item_get_type #} -- *************************************************************** WebInspector {#pointer *WebKitWebInspector as WebInspector foreign newtype #} deriving (Eq,Ord) mkWebInspector = (WebInspector, objectUnrefFromMainloop) unWebInspector (WebInspector o) = o class GObjectClass o => WebInspectorClass o toWebInspector :: WebInspectorClass o => o -> WebInspector toWebInspector = unsafeCastGObject . toGObject instance WebInspectorClass WebInspector instance GObjectClass WebInspector where toGObject = GObject . castForeignPtr . unWebInspector unsafeCastGObject = WebInspector . castForeignPtr . unGObject castToWebInspector :: GObjectClass obj => obj -> WebInspector castToWebInspector = castTo gTypeWebInspector "WebInspector" gTypeWebInspector :: GType gTypeWebInspector = {# call fun unsafe webkit_web_inspector_get_type #} -- ************************************************************** HitTestResult {#pointer *WebKitHitTestResult as HitTestResult foreign newtype #} deriving (Eq,Ord) mkHitTestResult = (HitTestResult, objectUnrefFromMainloop) unHitTestResult (HitTestResult o) = o class GObjectClass o => HitTestResultClass o toHitTestResult :: HitTestResultClass o => o -> HitTestResult toHitTestResult = unsafeCastGObject . toGObject instance HitTestResultClass HitTestResult instance GObjectClass HitTestResult where toGObject = GObject . castForeignPtr . unHitTestResult unsafeCastGObject = HitTestResult . castForeignPtr . unGObject castToHitTestResult :: GObjectClass obj => obj -> HitTestResult castToHitTestResult = castTo gTypeHitTestResult "HitTestResult" gTypeHitTestResult :: GType gTypeHitTestResult = {# call fun unsafe webkit_hit_test_result_get_type #} -- ************************************************************* SecurityOrigin {#pointer *WebKitSecurityOrigin as SecurityOrigin foreign newtype #} deriving (Eq,Ord) mkSecurityOrigin = (SecurityOrigin, objectUnrefFromMainloop) unSecurityOrigin (SecurityOrigin o) = o class GObjectClass o => SecurityOriginClass o toSecurityOrigin :: SecurityOriginClass o => o -> SecurityOrigin toSecurityOrigin = unsafeCastGObject . toGObject instance SecurityOriginClass SecurityOrigin instance GObjectClass SecurityOrigin where toGObject = GObject . castForeignPtr . unSecurityOrigin unsafeCastGObject = SecurityOrigin . castForeignPtr . unGObject castToSecurityOrigin :: GObjectClass obj => obj -> SecurityOrigin castToSecurityOrigin = castTo gTypeSecurityOrigin "SecurityOrigin" gTypeSecurityOrigin :: GType gTypeSecurityOrigin = {# call fun unsafe webkit_security_origin_get_type #} -- ************************************************************* SoupAuthDialog {#pointer *WebKitSoupAuthDialog as SoupAuthDialog foreign newtype #} deriving (Eq,Ord) mkSoupAuthDialog = (SoupAuthDialog, objectUnrefFromMainloop) unSoupAuthDialog (SoupAuthDialog o) = o class GObjectClass o => SoupAuthDialogClass o toSoupAuthDialog :: SoupAuthDialogClass o => o -> SoupAuthDialog toSoupAuthDialog = unsafeCastGObject . toGObject instance SoupAuthDialogClass SoupAuthDialog instance GObjectClass SoupAuthDialog where toGObject = GObject . castForeignPtr . unSoupAuthDialog unsafeCastGObject = SoupAuthDialog . castForeignPtr . unGObject castToSoupAuthDialog :: GObjectClass obj => obj -> SoupAuthDialog castToSoupAuthDialog = castTo gTypeSoupAuthDialog "SoupAuthDialog" gTypeSoupAuthDialog :: GType gTypeSoupAuthDialog = {# call fun unsafe webkit_soup_auth_dialog_get_type #} -- **************************************************************** WebDatabase {#pointer *WebKitWebDatabase as WebDatabase foreign newtype #} deriving (Eq,Ord) mkWebDatabase = (WebDatabase, objectUnrefFromMainloop) unWebDatabase (WebDatabase o) = o class GObjectClass o => WebDatabaseClass o toWebDatabase :: WebDatabaseClass o => o -> WebDatabase toWebDatabase = unsafeCastGObject . toGObject instance WebDatabaseClass WebDatabase instance GObjectClass WebDatabase where toGObject = GObject . castForeignPtr . unWebDatabase unsafeCastGObject = WebDatabase . castForeignPtr . unGObject castToWebDatabase :: GObjectClass obj => obj -> WebDatabase castToWebDatabase = castTo gTypeWebDatabase "WebDatabase" gTypeWebDatabase :: GType gTypeWebDatabase = {# call fun unsafe webkit_web_database_get_type #} -- ************************************************************** WebDataSource {#pointer *WebKitWebDataSource as WebDataSource foreign newtype #} deriving (Eq,Ord) mkWebDataSource = (WebDataSource, objectUnrefFromMainloop) unWebDataSource (WebDataSource o) = o class GObjectClass o => WebDataSourceClass o toWebDataSource :: WebDataSourceClass o => o -> WebDataSource toWebDataSource = unsafeCastGObject . toGObject instance WebDataSourceClass WebDataSource instance GObjectClass WebDataSource where toGObject = GObject . castForeignPtr . unWebDataSource unsafeCastGObject = WebDataSource . castForeignPtr . unGObject castToWebDataSource :: GObjectClass obj => obj -> WebDataSource castToWebDataSource = castTo gTypeWebDataSource "WebDataSource" gTypeWebDataSource :: GType gTypeWebDataSource = {# call fun unsafe webkit_web_data_source_get_type #} -- ******************************************************** WebNavigationAction {#pointer *WebKitWebNavigationAction as WebNavigationAction foreign newtype #} deriving (Eq,Ord) mkWebNavigationAction = (WebNavigationAction, objectUnrefFromMainloop) unWebNavigationAction (WebNavigationAction o) = o class GObjectClass o => WebNavigationActionClass o toWebNavigationAction :: WebNavigationActionClass o => o -> WebNavigationAction toWebNavigationAction = unsafeCastGObject . toGObject instance WebNavigationActionClass WebNavigationAction instance GObjectClass WebNavigationAction where toGObject = GObject . castForeignPtr . unWebNavigationAction unsafeCastGObject = WebNavigationAction . castForeignPtr . unGObject castToWebNavigationAction :: GObjectClass obj => obj -> WebNavigationAction castToWebNavigationAction = castTo gTypeWebNavigationAction "WebNavigationAction" gTypeWebNavigationAction :: GType gTypeWebNavigationAction = {# call fun unsafe webkit_web_navigation_action_get_type #} -- ********************************************************** WebPolicyDecision {#pointer *WebKitWebPolicyDecision as WebPolicyDecision foreign newtype #} deriving (Eq,Ord) mkWebPolicyDecision = (WebPolicyDecision, objectUnrefFromMainloop) unWebPolicyDecision (WebPolicyDecision o) = o class GObjectClass o => WebPolicyDecisionClass o toWebPolicyDecision :: WebPolicyDecisionClass o => o -> WebPolicyDecision toWebPolicyDecision = unsafeCastGObject . toGObject instance WebPolicyDecisionClass WebPolicyDecision instance GObjectClass WebPolicyDecision where toGObject = GObject . castForeignPtr . unWebPolicyDecision unsafeCastGObject = WebPolicyDecision . castForeignPtr . unGObject castToWebPolicyDecision :: GObjectClass obj => obj -> WebPolicyDecision castToWebPolicyDecision = castTo gTypeWebPolicyDecision "WebPolicyDecision" gTypeWebPolicyDecision :: GType gTypeWebPolicyDecision = {# call fun unsafe webkit_web_policy_decision_get_type #} -- **************************************************************** WebResource {#pointer *WebKitWebResource as WebResource foreign newtype #} deriving (Eq,Ord) mkWebResource = (WebResource, objectUnrefFromMainloop) unWebResource (WebResource o) = o class GObjectClass o => WebResourceClass o toWebResource :: WebResourceClass o => o -> WebResource toWebResource = unsafeCastGObject . toGObject instance WebResourceClass WebResource instance GObjectClass WebResource where toGObject = GObject . castForeignPtr . unWebResource unsafeCastGObject = WebResource . castForeignPtr . unGObject castToWebResource :: GObjectClass obj => obj -> WebResource castToWebResource = castTo gTypeWebResource "WebResource" gTypeWebResource :: GType gTypeWebResource = {# call fun unsafe webkit_web_resource_get_type #} -- ********************************************************** WebWindowFeatures {#pointer *WebKitWebWindowFeatures as WebWindowFeatures foreign newtype #} deriving (Eq,Ord) mkWebWindowFeatures = (WebWindowFeatures, objectUnrefFromMainloop) unWebWindowFeatures (WebWindowFeatures o) = o class GObjectClass o => WebWindowFeaturesClass o toWebWindowFeatures :: WebWindowFeaturesClass o => o -> WebWindowFeatures toWebWindowFeatures = unsafeCastGObject . toGObject instance WebWindowFeaturesClass WebWindowFeatures instance GObjectClass WebWindowFeatures where toGObject = GObject . castForeignPtr . unWebWindowFeatures unsafeCastGObject = WebWindowFeatures . castForeignPtr . unGObject castToWebWindowFeatures :: GObjectClass obj => obj -> WebWindowFeatures castToWebWindowFeatures = castTo gTypeWebWindowFeatures "WebWindowFeatures" gTypeWebWindowFeatures :: GType gTypeWebWindowFeatures = {# call fun unsafe webkit_web_window_features_get_type #} -- ************************************************** GeolocationPolicyDecision {#pointer *WebKitGeolocationPolicyDecision as GeolocationPolicyDecision foreign newtype #} deriving (Eq,Ord) mkGeolocationPolicyDecision = (GeolocationPolicyDecision, objectUnrefFromMainloop) unGeolocationPolicyDecision (GeolocationPolicyDecision o) = o class GObjectClass o => GeolocationPolicyDecisionClass o toGeolocationPolicyDecision :: GeolocationPolicyDecisionClass o => o -> GeolocationPolicyDecision toGeolocationPolicyDecision = unsafeCastGObject . toGObject instance GeolocationPolicyDecisionClass GeolocationPolicyDecision instance GObjectClass GeolocationPolicyDecision where toGObject = GObject . castForeignPtr . unGeolocationPolicyDecision unsafeCastGObject = GeolocationPolicyDecision . castForeignPtr . unGObject castToGeolocationPolicyDecision :: GObjectClass obj => obj -> GeolocationPolicyDecision castToGeolocationPolicyDecision = castTo gTypeGeolocationPolicyDecision "GeolocationPolicyDecision" gTypeGeolocationPolicyDecision :: GType gTypeGeolocationPolicyDecision = {# call fun unsafe webkit_geolocation_policy_decision_get_type #}