{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.WebKit2.Objects.ContextMenu
    ( 

-- * Exported types
    ContextMenu(..)                         ,
    IsContextMenu                           ,
    toContextMenu                           ,
    noContextMenu                           ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveContextMenuMethod                ,
#endif


-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    ContextMenuAppendMethodInfo             ,
#endif
    contextMenuAppend                       ,


-- ** first #method:first#

#if defined(ENABLE_OVERLOADING)
    ContextMenuFirstMethodInfo              ,
#endif
    contextMenuFirst                        ,


-- ** getItemAtPosition #method:getItemAtPosition#

#if defined(ENABLE_OVERLOADING)
    ContextMenuGetItemAtPositionMethodInfo  ,
#endif
    contextMenuGetItemAtPosition            ,


-- ** getItems #method:getItems#

#if defined(ENABLE_OVERLOADING)
    ContextMenuGetItemsMethodInfo           ,
#endif
    contextMenuGetItems                     ,


-- ** getNItems #method:getNItems#

#if defined(ENABLE_OVERLOADING)
    ContextMenuGetNItemsMethodInfo          ,
#endif
    contextMenuGetNItems                    ,


-- ** getUserData #method:getUserData#

#if defined(ENABLE_OVERLOADING)
    ContextMenuGetUserDataMethodInfo        ,
#endif
    contextMenuGetUserData                  ,


-- ** insert #method:insert#

#if defined(ENABLE_OVERLOADING)
    ContextMenuInsertMethodInfo             ,
#endif
    contextMenuInsert                       ,


-- ** last #method:last#

#if defined(ENABLE_OVERLOADING)
    ContextMenuLastMethodInfo               ,
#endif
    contextMenuLast                         ,


-- ** moveItem #method:moveItem#

#if defined(ENABLE_OVERLOADING)
    ContextMenuMoveItemMethodInfo           ,
#endif
    contextMenuMoveItem                     ,


-- ** new #method:new#

    contextMenuNew                          ,


-- ** newWithItems #method:newWithItems#

    contextMenuNewWithItems                 ,


-- ** prepend #method:prepend#

#if defined(ENABLE_OVERLOADING)
    ContextMenuPrependMethodInfo            ,
#endif
    contextMenuPrepend                      ,


-- ** remove #method:remove#

#if defined(ENABLE_OVERLOADING)
    ContextMenuRemoveMethodInfo             ,
#endif
    contextMenuRemove                       ,


-- ** removeAll #method:removeAll#

#if defined(ENABLE_OVERLOADING)
    ContextMenuRemoveAllMethodInfo          ,
#endif
    contextMenuRemoveAll                    ,


-- ** setUserData #method:setUserData#

#if defined(ENABLE_OVERLOADING)
    ContextMenuSetUserDataMethodInfo        ,
#endif
    contextMenuSetUserData                  ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import qualified GI.GObject.Objects.Object as GObject.Object
import {-# SOURCE #-} qualified GI.WebKit2.Objects.ContextMenuItem as WebKit2.ContextMenuItem

-- | Memory-managed wrapper type.
newtype ContextMenu = ContextMenu (ManagedPtr ContextMenu)
    deriving (ContextMenu -> ContextMenu -> Bool
(ContextMenu -> ContextMenu -> Bool)
-> (ContextMenu -> ContextMenu -> Bool) -> Eq ContextMenu
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextMenu -> ContextMenu -> Bool
$c/= :: ContextMenu -> ContextMenu -> Bool
== :: ContextMenu -> ContextMenu -> Bool
$c== :: ContextMenu -> ContextMenu -> Bool
Eq)
foreign import ccall "webkit_context_menu_get_type"
    c_webkit_context_menu_get_type :: IO GType

instance GObject ContextMenu where
    gobjectType :: IO GType
gobjectType = IO GType
c_webkit_context_menu_get_type
    

-- | Convert 'ContextMenu' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue ContextMenu where
    toGValue :: ContextMenu -> IO GValue
toGValue o :: ContextMenu
o = do
        GType
gtype <- IO GType
c_webkit_context_menu_get_type
        ContextMenu -> (Ptr ContextMenu -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr ContextMenu
o (GType
-> (GValue -> Ptr ContextMenu -> IO ())
-> Ptr ContextMenu
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr ContextMenu -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO ContextMenu
fromGValue gv :: GValue
gv = do
        Ptr ContextMenu
ptr <- GValue -> IO (Ptr ContextMenu)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr ContextMenu)
        (ManagedPtr ContextMenu -> ContextMenu)
-> Ptr ContextMenu -> IO ContextMenu
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr ContextMenu -> ContextMenu
ContextMenu Ptr ContextMenu
ptr
        
    

-- | Type class for types which can be safely cast to `ContextMenu`, for instance with `toContextMenu`.
class (GObject o, O.IsDescendantOf ContextMenu o) => IsContextMenu o
instance (GObject o, O.IsDescendantOf ContextMenu o) => IsContextMenu o

instance O.HasParentTypes ContextMenu
type instance O.ParentTypes ContextMenu = '[GObject.Object.Object]

-- | Cast to `ContextMenu`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toContextMenu :: (MonadIO m, IsContextMenu o) => o -> m ContextMenu
toContextMenu :: o -> m ContextMenu
toContextMenu = IO ContextMenu -> m ContextMenu
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContextMenu -> m ContextMenu)
-> (o -> IO ContextMenu) -> o -> m ContextMenu
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr ContextMenu -> ContextMenu) -> o -> IO ContextMenu
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr ContextMenu -> ContextMenu
ContextMenu

-- | A convenience alias for `Nothing` :: `Maybe` `ContextMenu`.
noContextMenu :: Maybe ContextMenu
noContextMenu :: Maybe ContextMenu
noContextMenu = Maybe ContextMenu
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveContextMenuMethod (t :: Symbol) (o :: *) :: * where
    ResolveContextMenuMethod "append" o = ContextMenuAppendMethodInfo
    ResolveContextMenuMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveContextMenuMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveContextMenuMethod "first" o = ContextMenuFirstMethodInfo
    ResolveContextMenuMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveContextMenuMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveContextMenuMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveContextMenuMethod "insert" o = ContextMenuInsertMethodInfo
    ResolveContextMenuMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveContextMenuMethod "last" o = ContextMenuLastMethodInfo
    ResolveContextMenuMethod "moveItem" o = ContextMenuMoveItemMethodInfo
    ResolveContextMenuMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveContextMenuMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveContextMenuMethod "prepend" o = ContextMenuPrependMethodInfo
    ResolveContextMenuMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveContextMenuMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveContextMenuMethod "remove" o = ContextMenuRemoveMethodInfo
    ResolveContextMenuMethod "removeAll" o = ContextMenuRemoveAllMethodInfo
    ResolveContextMenuMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveContextMenuMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveContextMenuMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveContextMenuMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveContextMenuMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveContextMenuMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveContextMenuMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveContextMenuMethod "getItemAtPosition" o = ContextMenuGetItemAtPositionMethodInfo
    ResolveContextMenuMethod "getItems" o = ContextMenuGetItemsMethodInfo
    ResolveContextMenuMethod "getNItems" o = ContextMenuGetNItemsMethodInfo
    ResolveContextMenuMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveContextMenuMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveContextMenuMethod "getUserData" o = ContextMenuGetUserDataMethodInfo
    ResolveContextMenuMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveContextMenuMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveContextMenuMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveContextMenuMethod "setUserData" o = ContextMenuSetUserDataMethodInfo
    ResolveContextMenuMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveContextMenuMethod t ContextMenu, O.MethodInfo info ContextMenu p) => OL.IsLabel t (ContextMenu -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList ContextMenu
type instance O.AttributeList ContextMenu = ContextMenuAttributeList
type ContextMenuAttributeList = ('[ ] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList ContextMenu = ContextMenuSignalList
type ContextMenuSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

-- method ContextMenu::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "ContextMenu" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_new" webkit_context_menu_new :: 
    IO (Ptr ContextMenu)

-- | Creates a new t'GI.WebKit2.Objects.ContextMenu.ContextMenu' object to be used as a submenu of an existing
-- t'GI.WebKit2.Objects.ContextMenu.ContextMenu'. The context menu of a t'GI.WebKit2.Objects.WebView.WebView' is created by the view
-- and passed as an argument of [contextMenu]("GI.WebKit2.Objects.WebView#signal:contextMenu") signal.
-- To add items to the menu use 'GI.WebKit2.Objects.ContextMenu.contextMenuPrepend',
-- 'GI.WebKit2.Objects.ContextMenu.contextMenuAppend' or 'GI.WebKit2.Objects.ContextMenu.contextMenuInsert'.
-- See also 'GI.WebKit2.Objects.ContextMenu.contextMenuNewWithItems' to create a t'GI.WebKit2.Objects.ContextMenu.ContextMenu' with
-- a list of initial items.
contextMenuNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m ContextMenu
    -- ^ __Returns:__ The newly created t'GI.WebKit2.Objects.ContextMenu.ContextMenu' object
contextMenuNew :: m ContextMenu
contextMenuNew  = IO ContextMenu -> m ContextMenu
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContextMenu -> m ContextMenu)
-> IO ContextMenu -> m ContextMenu
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
result <- IO (Ptr ContextMenu)
webkit_context_menu_new
    Text -> Ptr ContextMenu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextMenuNew" Ptr ContextMenu
result
    ContextMenu
result' <- ((ManagedPtr ContextMenu -> ContextMenu)
-> Ptr ContextMenu -> IO ContextMenu
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ContextMenu -> ContextMenu
ContextMenu) Ptr ContextMenu
result
    ContextMenu -> IO ContextMenu
forall (m :: * -> *) a. Monad m => a -> m a
return ContextMenu
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ContextMenu::new_with_items
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "items"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "WebKit2" , name = "ContextMenuItem" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GList of #WebKitContextMenuItem"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "ContextMenu" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_new_with_items" webkit_context_menu_new_with_items :: 
    Ptr (GList (Ptr WebKit2.ContextMenuItem.ContextMenuItem)) -> -- items : TGList (TInterface (Name {namespace = "WebKit2", name = "ContextMenuItem"}))
    IO (Ptr ContextMenu)

-- | Creates a new t'GI.WebKit2.Objects.ContextMenu.ContextMenu' object to be used as a submenu of an existing
-- t'GI.WebKit2.Objects.ContextMenu.ContextMenu' with the given initial items.
-- See also 'GI.WebKit2.Objects.ContextMenu.contextMenuNew'
contextMenuNewWithItems ::
    (B.CallStack.HasCallStack, MonadIO m, WebKit2.ContextMenuItem.IsContextMenuItem a) =>
    [a]
    -- ^ /@items@/: a t'GI.GLib.Structs.List.List' of t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem'
    -> m ContextMenu
    -- ^ __Returns:__ The newly created t'GI.WebKit2.Objects.ContextMenu.ContextMenu' object
contextMenuNewWithItems :: [a] -> m ContextMenu
contextMenuNewWithItems items :: [a]
items = IO ContextMenu -> m ContextMenu
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ContextMenu -> m ContextMenu)
-> IO ContextMenu -> m ContextMenu
forall a b. (a -> b) -> a -> b
$ do
    [Ptr ContextMenuItem]
items' <- (a -> IO (Ptr ContextMenuItem)) -> [a] -> IO [Ptr ContextMenuItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> IO (Ptr ContextMenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [a]
items
    Ptr (GList (Ptr ContextMenuItem))
items'' <- [Ptr ContextMenuItem] -> IO (Ptr (GList (Ptr ContextMenuItem)))
forall a. [Ptr a] -> IO (Ptr (GList (Ptr a)))
packGList [Ptr ContextMenuItem]
items'
    Ptr ContextMenu
result <- Ptr (GList (Ptr ContextMenuItem)) -> IO (Ptr ContextMenu)
webkit_context_menu_new_with_items Ptr (GList (Ptr ContextMenuItem))
items''
    Text -> Ptr ContextMenu -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "contextMenuNewWithItems" Ptr ContextMenu
result
    ContextMenu
result' <- ((ManagedPtr ContextMenu -> ContextMenu)
-> Ptr ContextMenu -> IO ContextMenu
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr ContextMenu -> ContextMenu
ContextMenu) Ptr ContextMenu
result
    (a -> IO ()) -> [a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [a]
items
    Ptr (GList (Ptr ContextMenuItem)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr ContextMenuItem))
items''
    ContextMenu -> IO ContextMenu
forall (m :: * -> *) a. Monad m => a -> m a
return ContextMenu
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method ContextMenu::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ContextMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitContextMenuItem to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_append" webkit_context_menu_append :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    Ptr WebKit2.ContextMenuItem.ContextMenuItem -> -- item : TInterface (Name {namespace = "WebKit2", name = "ContextMenuItem"})
    IO ()

-- | Adds /@item@/ at the end of the /@menu@/.
contextMenuAppend ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> b
    -- ^ /@item@/: the t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem' to add
    -> m ()
contextMenuAppend :: a -> b -> m ()
contextMenuAppend menu :: a
menu item :: b
item = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenuItem
item' <- b -> IO (Ptr ContextMenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr ContextMenu -> Ptr ContextMenuItem -> IO ()
webkit_context_menu_append Ptr ContextMenu
menu' Ptr ContextMenuItem
item'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextMenuAppendMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) => O.MethodInfo ContextMenuAppendMethodInfo a signature where
    overloadedMethod = contextMenuAppend

#endif

-- method ContextMenu::first
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "ContextMenuItem" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_first" webkit_context_menu_first :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    IO (Ptr WebKit2.ContextMenuItem.ContextMenuItem)

-- | Gets the first item in the /@menu@/.
contextMenuFirst ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> m (Maybe WebKit2.ContextMenuItem.ContextMenuItem)
    -- ^ __Returns:__ the first t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem' of /@menu@/,
    --    or 'P.Nothing' if the t'GI.WebKit2.Objects.ContextMenu.ContextMenu' is empty.
contextMenuFirst :: a -> m (Maybe ContextMenuItem)
contextMenuFirst menu :: a
menu = IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem))
-> IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenuItem
result <- Ptr ContextMenu -> IO (Ptr ContextMenuItem)
webkit_context_menu_first Ptr ContextMenu
menu'
    Maybe ContextMenuItem
maybeResult <- Ptr ContextMenuItem
-> (Ptr ContextMenuItem -> IO ContextMenuItem)
-> IO (Maybe ContextMenuItem)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ContextMenuItem
result ((Ptr ContextMenuItem -> IO ContextMenuItem)
 -> IO (Maybe ContextMenuItem))
-> (Ptr ContextMenuItem -> IO ContextMenuItem)
-> IO (Maybe ContextMenuItem)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr ContextMenuItem
result' -> do
        ContextMenuItem
result'' <- ((ManagedPtr ContextMenuItem -> ContextMenuItem)
-> Ptr ContextMenuItem -> IO ContextMenuItem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ContextMenuItem -> ContextMenuItem
WebKit2.ContextMenuItem.ContextMenuItem) Ptr ContextMenuItem
result'
        ContextMenuItem -> IO ContextMenuItem
forall (m :: * -> *) a. Monad m => a -> m a
return ContextMenuItem
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Maybe ContextMenuItem -> IO (Maybe ContextMenuItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ContextMenuItem
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContextMenuFirstMethodInfo
instance (signature ~ (m (Maybe WebKit2.ContextMenuItem.ContextMenuItem)), MonadIO m, IsContextMenu a) => O.MethodInfo ContextMenuFirstMethodInfo a signature where
    overloadedMethod = contextMenuFirst

#endif

-- method ContextMenu::get_item_at_position
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position of the item, counting from 0"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "ContextMenuItem" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_get_item_at_position" webkit_context_menu_get_item_at_position :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    Word32 ->                               -- position : TBasicType TUInt
    IO (Ptr WebKit2.ContextMenuItem.ContextMenuItem)

-- | Gets the item at the given position in the /@menu@/.
contextMenuGetItemAtPosition ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> Word32
    -- ^ /@position@/: the position of the item, counting from 0
    -> m (Maybe WebKit2.ContextMenuItem.ContextMenuItem)
    -- ^ __Returns:__ the t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem' at position /@position@/ in /@menu@/,
    --    or 'P.Nothing' if the position is off the end of the /@menu@/.
contextMenuGetItemAtPosition :: a -> Word32 -> m (Maybe ContextMenuItem)
contextMenuGetItemAtPosition menu :: a
menu position :: Word32
position = IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem))
-> IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenuItem
result <- Ptr ContextMenu -> Word32 -> IO (Ptr ContextMenuItem)
webkit_context_menu_get_item_at_position Ptr ContextMenu
menu' Word32
position
    Maybe ContextMenuItem
maybeResult <- Ptr ContextMenuItem
-> (Ptr ContextMenuItem -> IO ContextMenuItem)
-> IO (Maybe ContextMenuItem)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ContextMenuItem
result ((Ptr ContextMenuItem -> IO ContextMenuItem)
 -> IO (Maybe ContextMenuItem))
-> (Ptr ContextMenuItem -> IO ContextMenuItem)
-> IO (Maybe ContextMenuItem)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr ContextMenuItem
result' -> do
        ContextMenuItem
result'' <- ((ManagedPtr ContextMenuItem -> ContextMenuItem)
-> Ptr ContextMenuItem -> IO ContextMenuItem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ContextMenuItem -> ContextMenuItem
WebKit2.ContextMenuItem.ContextMenuItem) Ptr ContextMenuItem
result'
        ContextMenuItem -> IO ContextMenuItem
forall (m :: * -> *) a. Monad m => a -> m a
return ContextMenuItem
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Maybe ContextMenuItem -> IO (Maybe ContextMenuItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ContextMenuItem
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContextMenuGetItemAtPositionMethodInfo
instance (signature ~ (Word32 -> m (Maybe WebKit2.ContextMenuItem.ContextMenuItem)), MonadIO m, IsContextMenu a) => O.MethodInfo ContextMenuGetItemAtPositionMethodInfo a signature where
    overloadedMethod = contextMenuGetItemAtPosition

#endif

-- method ContextMenu::get_items
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TGList
--                  (TInterface
--                     Name { namespace = "WebKit2" , name = "ContextMenuItem" }))
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_get_items" webkit_context_menu_get_items :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    IO (Ptr (GList (Ptr WebKit2.ContextMenuItem.ContextMenuItem)))

-- | Returns the item list of /@menu@/.
contextMenuGetItems ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> m [WebKit2.ContextMenuItem.ContextMenuItem]
    -- ^ __Returns:__ a t'GI.GLib.Structs.List.List' of
    --    t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem's
contextMenuGetItems :: a -> m [ContextMenuItem]
contextMenuGetItems menu :: a
menu = IO [ContextMenuItem] -> m [ContextMenuItem]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [ContextMenuItem] -> m [ContextMenuItem])
-> IO [ContextMenuItem] -> m [ContextMenuItem]
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr (GList (Ptr ContextMenuItem))
result <- Ptr ContextMenu -> IO (Ptr (GList (Ptr ContextMenuItem)))
webkit_context_menu_get_items Ptr ContextMenu
menu'
    [Ptr ContextMenuItem]
result' <- Ptr (GList (Ptr ContextMenuItem)) -> IO [Ptr ContextMenuItem]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr ContextMenuItem))
result
    [ContextMenuItem]
result'' <- (Ptr ContextMenuItem -> IO ContextMenuItem)
-> [Ptr ContextMenuItem] -> IO [ContextMenuItem]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr ContextMenuItem -> ContextMenuItem)
-> Ptr ContextMenuItem -> IO ContextMenuItem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ContextMenuItem -> ContextMenuItem
WebKit2.ContextMenuItem.ContextMenuItem) [Ptr ContextMenuItem]
result'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    [ContextMenuItem] -> IO [ContextMenuItem]
forall (m :: * -> *) a. Monad m => a -> m a
return [ContextMenuItem]
result''

#if defined(ENABLE_OVERLOADING)
data ContextMenuGetItemsMethodInfo
instance (signature ~ (m [WebKit2.ContextMenuItem.ContextMenuItem]), MonadIO m, IsContextMenu a) => O.MethodInfo ContextMenuGetItemsMethodInfo a signature where
    overloadedMethod = contextMenuGetItems

#endif

-- method ContextMenu::get_n_items
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_get_n_items" webkit_context_menu_get_n_items :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    IO Word32

-- | Gets the length of the /@menu@/.
contextMenuGetNItems ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> m Word32
    -- ^ __Returns:__ the number of t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem's in /@menu@/
contextMenuGetNItems :: a -> m Word32
contextMenuGetNItems menu :: a
menu = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Word32
result <- Ptr ContextMenu -> IO Word32
webkit_context_menu_get_n_items Ptr ContextMenu
menu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data ContextMenuGetNItemsMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsContextMenu a) => O.MethodInfo ContextMenuGetNItemsMethodInfo a signature where
    overloadedMethod = contextMenuGetNItems

#endif

-- method ContextMenu::get_user_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_get_user_data" webkit_context_menu_get_user_data :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    IO (Ptr GVariant)

-- | Gets the user data of /@menu@/.
-- This function can be used from the UI Process to get user data previously set
-- from the Web Process with 'GI.WebKit2.Objects.ContextMenu.contextMenuSetUserData'.
-- 
-- /Since: 2.8/
contextMenuGetUserData ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> m (Maybe GVariant)
    -- ^ __Returns:__ the user data of /@menu@/, or 'P.Nothing' if /@menu@/ doesn\'t have user data
contextMenuGetUserData :: a -> m (Maybe GVariant)
contextMenuGetUserData menu :: a
menu = IO (Maybe GVariant) -> m (Maybe GVariant)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe GVariant) -> m (Maybe GVariant))
-> IO (Maybe GVariant) -> m (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr GVariant
result <- Ptr ContextMenu -> IO (Ptr GVariant)
webkit_context_menu_get_user_data Ptr ContextMenu
menu'
    Maybe GVariant
maybeResult <- Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant
result ((Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr GVariant
result' -> do
        GVariant
result'' <- Ptr GVariant -> IO GVariant
B.GVariant.newGVariantFromPtr Ptr GVariant
result'
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Maybe GVariant -> IO (Maybe GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GVariant
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContextMenuGetUserDataMethodInfo
instance (signature ~ (m (Maybe GVariant)), MonadIO m, IsContextMenu a) => O.MethodInfo ContextMenuGetUserDataMethodInfo a signature where
    overloadedMethod = contextMenuGetUserData

#endif

-- method ContextMenu::insert
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ContextMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitContextMenuItem to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the position to insert the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_insert" webkit_context_menu_insert :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    Ptr WebKit2.ContextMenuItem.ContextMenuItem -> -- item : TInterface (Name {namespace = "WebKit2", name = "ContextMenuItem"})
    Int32 ->                                -- position : TBasicType TInt
    IO ()

-- | Inserts /@item@/ into the /@menu@/ at the given position.
-- If /@position@/ is negative, or is larger than the number of items
-- in the t'GI.WebKit2.Objects.ContextMenu.ContextMenu', the item is added on to the end of
-- the /@menu@/. The first position is 0.
contextMenuInsert ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> b
    -- ^ /@item@/: the t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem' to add
    -> Int32
    -- ^ /@position@/: the position to insert the item
    -> m ()
contextMenuInsert :: a -> b -> Int32 -> m ()
contextMenuInsert menu :: a
menu item :: b
item position :: Int32
position = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenuItem
item' <- b -> IO (Ptr ContextMenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr ContextMenu -> Ptr ContextMenuItem -> Int32 -> IO ()
webkit_context_menu_insert Ptr ContextMenu
menu' Ptr ContextMenuItem
item' Int32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextMenuInsertMethodInfo
instance (signature ~ (b -> Int32 -> m ()), MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) => O.MethodInfo ContextMenuInsertMethodInfo a signature where
    overloadedMethod = contextMenuInsert

#endif

-- method ContextMenu::last
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "ContextMenuItem" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_last" webkit_context_menu_last :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    IO (Ptr WebKit2.ContextMenuItem.ContextMenuItem)

-- | Gets the last item in the /@menu@/.
contextMenuLast ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> m (Maybe WebKit2.ContextMenuItem.ContextMenuItem)
    -- ^ __Returns:__ the last t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem' of /@menu@/,
    --    or 'P.Nothing' if the t'GI.WebKit2.Objects.ContextMenu.ContextMenu' is empty.
contextMenuLast :: a -> m (Maybe ContextMenuItem)
contextMenuLast menu :: a
menu = IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem))
-> IO (Maybe ContextMenuItem) -> m (Maybe ContextMenuItem)
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenuItem
result <- Ptr ContextMenu -> IO (Ptr ContextMenuItem)
webkit_context_menu_last Ptr ContextMenu
menu'
    Maybe ContextMenuItem
maybeResult <- Ptr ContextMenuItem
-> (Ptr ContextMenuItem -> IO ContextMenuItem)
-> IO (Maybe ContextMenuItem)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr ContextMenuItem
result ((Ptr ContextMenuItem -> IO ContextMenuItem)
 -> IO (Maybe ContextMenuItem))
-> (Ptr ContextMenuItem -> IO ContextMenuItem)
-> IO (Maybe ContextMenuItem)
forall a b. (a -> b) -> a -> b
$ \result' :: Ptr ContextMenuItem
result' -> do
        ContextMenuItem
result'' <- ((ManagedPtr ContextMenuItem -> ContextMenuItem)
-> Ptr ContextMenuItem -> IO ContextMenuItem
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr ContextMenuItem -> ContextMenuItem
WebKit2.ContextMenuItem.ContextMenuItem) Ptr ContextMenuItem
result'
        ContextMenuItem -> IO ContextMenuItem
forall (m :: * -> *) a. Monad m => a -> m a
return ContextMenuItem
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    Maybe ContextMenuItem -> IO (Maybe ContextMenuItem)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe ContextMenuItem
maybeResult

#if defined(ENABLE_OVERLOADING)
data ContextMenuLastMethodInfo
instance (signature ~ (m (Maybe WebKit2.ContextMenuItem.ContextMenuItem)), MonadIO m, IsContextMenu a) => O.MethodInfo ContextMenuLastMethodInfo a signature where
    overloadedMethod = contextMenuLast

#endif

-- method ContextMenu::move_item
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ContextMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitContextMenuItem to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "position"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the new position to move the item"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_move_item" webkit_context_menu_move_item :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    Ptr WebKit2.ContextMenuItem.ContextMenuItem -> -- item : TInterface (Name {namespace = "WebKit2", name = "ContextMenuItem"})
    Int32 ->                                -- position : TBasicType TInt
    IO ()

-- | Moves /@item@/ to the given position in the /@menu@/.
-- If /@position@/ is negative, or is larger than the number of items
-- in the t'GI.WebKit2.Objects.ContextMenu.ContextMenu', the item is added on to the end of
-- the /@menu@/.
-- The first position is 0.
contextMenuMoveItem ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> b
    -- ^ /@item@/: the t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem' to add
    -> Int32
    -- ^ /@position@/: the new position to move the item
    -> m ()
contextMenuMoveItem :: a -> b -> Int32 -> m ()
contextMenuMoveItem menu :: a
menu item :: b
item position :: Int32
position = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenuItem
item' <- b -> IO (Ptr ContextMenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr ContextMenu -> Ptr ContextMenuItem -> Int32 -> IO ()
webkit_context_menu_move_item Ptr ContextMenu
menu' Ptr ContextMenuItem
item' Int32
position
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextMenuMoveItemMethodInfo
instance (signature ~ (b -> Int32 -> m ()), MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) => O.MethodInfo ContextMenuMoveItemMethodInfo a signature where
    overloadedMethod = contextMenuMoveItem

#endif

-- method ContextMenu::prepend
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ContextMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitContextMenuItem to add"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_prepend" webkit_context_menu_prepend :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    Ptr WebKit2.ContextMenuItem.ContextMenuItem -> -- item : TInterface (Name {namespace = "WebKit2", name = "ContextMenuItem"})
    IO ()

-- | Adds /@item@/ at the beginning of the /@menu@/.
contextMenuPrepend ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> b
    -- ^ /@item@/: the t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem' to add
    -> m ()
contextMenuPrepend :: a -> b -> m ()
contextMenuPrepend menu :: a
menu item :: b
item = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenuItem
item' <- b -> IO (Ptr ContextMenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr ContextMenu -> Ptr ContextMenuItem -> IO ()
webkit_context_menu_prepend Ptr ContextMenu
menu' Ptr ContextMenuItem
item'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextMenuPrependMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) => O.MethodInfo ContextMenuPrependMethodInfo a signature where
    overloadedMethod = contextMenuPrepend

#endif

-- method ContextMenu::remove
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "item"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "ContextMenuItem" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #WebKitContextMenuItem to remove"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_remove" webkit_context_menu_remove :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    Ptr WebKit2.ContextMenuItem.ContextMenuItem -> -- item : TInterface (Name {namespace = "WebKit2", name = "ContextMenuItem"})
    IO ()

-- | Removes /@item@/ from the /@menu@/.
-- See also 'GI.WebKit2.Objects.ContextMenu.contextMenuRemoveAll' to remove all items.
contextMenuRemove ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> b
    -- ^ /@item@/: the t'GI.WebKit2.Objects.ContextMenuItem.ContextMenuItem' to remove
    -> m ()
contextMenuRemove :: a -> b -> m ()
contextMenuRemove menu :: a
menu item :: b
item = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenuItem
item' <- b -> IO (Ptr ContextMenuItem)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
item
    Ptr ContextMenu -> Ptr ContextMenuItem -> IO ()
webkit_context_menu_remove Ptr ContextMenu
menu' Ptr ContextMenuItem
item'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
item
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextMenuRemoveMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsContextMenu a, WebKit2.ContextMenuItem.IsContextMenuItem b) => O.MethodInfo ContextMenuRemoveMethodInfo a signature where
    overloadedMethod = contextMenuRemove

#endif

-- method ContextMenu::remove_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_remove_all" webkit_context_menu_remove_all :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    IO ()

-- | Removes all items of the /@menu@/.
contextMenuRemoveAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> m ()
contextMenuRemoveAll :: a -> m ()
contextMenuRemoveAll menu :: a
menu = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr ContextMenu -> IO ()
webkit_context_menu_remove_all Ptr ContextMenu
menu'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextMenuRemoveAllMethodInfo
instance (signature ~ (m ()), MonadIO m, IsContextMenu a) => O.MethodInfo ContextMenuRemoveAllMethodInfo a signature where
    overloadedMethod = contextMenuRemoveAll

#endif

-- method ContextMenu::set_user_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "menu"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "ContextMenu" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitContextMenu"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GVariant" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_context_menu_set_user_data" webkit_context_menu_set_user_data :: 
    Ptr ContextMenu ->                      -- menu : TInterface (Name {namespace = "WebKit2", name = "ContextMenu"})
    Ptr GVariant ->                         -- user_data : TVariant
    IO ()

-- | Sets user data to /@menu@/.
-- This function can be used from a Web Process extension to set user data
-- that can be retrieved from the UI Process using 'GI.WebKit2.Objects.ContextMenu.contextMenuGetUserData'.
-- If the /@userData@/ t'GVariant' is floating, it is consumed.
-- 
-- /Since: 2.8/
contextMenuSetUserData ::
    (B.CallStack.HasCallStack, MonadIO m, IsContextMenu a) =>
    a
    -- ^ /@menu@/: a t'GI.WebKit2.Objects.ContextMenu.ContextMenu'
    -> GVariant
    -- ^ /@userData@/: a t'GVariant'
    -> m ()
contextMenuSetUserData :: a -> GVariant -> m ()
contextMenuSetUserData menu :: a
menu userData :: GVariant
userData = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr ContextMenu
menu' <- a -> IO (Ptr ContextMenu)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
menu
    Ptr GVariant
userData' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
userData
    Ptr ContextMenu -> Ptr GVariant -> IO ()
webkit_context_menu_set_user_data Ptr ContextMenu
menu' Ptr GVariant
userData'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
menu
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
userData
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ContextMenuSetUserDataMethodInfo
instance (signature ~ (GVariant -> m ()), MonadIO m, IsContextMenu a) => O.MethodInfo ContextMenuSetUserDataMethodInfo a signature where
    overloadedMethod = contextMenuSetUserData

#endif