{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.InputMethodContext
    ( 

-- * Exported types
    InputMethodContext(..)                  ,
    IsInputMethodContext                    ,
    toInputMethodContext                    ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [filterKeyEvent]("GI.WebKit2.Objects.InputMethodContext#g:method:filterKeyEvent"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [notifyCursorArea]("GI.WebKit2.Objects.InputMethodContext#g:method:notifyCursorArea"), [notifyFocusIn]("GI.WebKit2.Objects.InputMethodContext#g:method:notifyFocusIn"), [notifyFocusOut]("GI.WebKit2.Objects.InputMethodContext#g:method:notifyFocusOut"), [notifySurrounding]("GI.WebKit2.Objects.InputMethodContext#g:method:notifySurrounding"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [reset]("GI.WebKit2.Objects.InputMethodContext#g:method:reset"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getInputHints]("GI.WebKit2.Objects.InputMethodContext#g:method:getInputHints"), [getInputPurpose]("GI.WebKit2.Objects.InputMethodContext#g:method:getInputPurpose"), [getPreedit]("GI.WebKit2.Objects.InputMethodContext#g:method:getPreedit"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setEnablePreedit]("GI.WebKit2.Objects.InputMethodContext#g:method:setEnablePreedit"), [setInputHints]("GI.WebKit2.Objects.InputMethodContext#g:method:setInputHints"), [setInputPurpose]("GI.WebKit2.Objects.InputMethodContext#g:method:setInputPurpose"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveInputMethodContextMethod         ,
#endif

-- ** filterKeyEvent #method:filterKeyEvent#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextFilterKeyEventMethodInfo,
#endif
    inputMethodContextFilterKeyEvent        ,


-- ** getInputHints #method:getInputHints#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextGetInputHintsMethodInfo,
#endif
    inputMethodContextGetInputHints         ,


-- ** getInputPurpose #method:getInputPurpose#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextGetInputPurposeMethodInfo,
#endif
    inputMethodContextGetInputPurpose       ,


-- ** getPreedit #method:getPreedit#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextGetPreeditMethodInfo  ,
#endif
    inputMethodContextGetPreedit            ,


-- ** notifyCursorArea #method:notifyCursorArea#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextNotifyCursorAreaMethodInfo,
#endif
    inputMethodContextNotifyCursorArea      ,


-- ** notifyFocusIn #method:notifyFocusIn#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextNotifyFocusInMethodInfo,
#endif
    inputMethodContextNotifyFocusIn         ,


-- ** notifyFocusOut #method:notifyFocusOut#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextNotifyFocusOutMethodInfo,
#endif
    inputMethodContextNotifyFocusOut        ,


-- ** notifySurrounding #method:notifySurrounding#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextNotifySurroundingMethodInfo,
#endif
    inputMethodContextNotifySurrounding     ,


-- ** reset #method:reset#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextResetMethodInfo       ,
#endif
    inputMethodContextReset                 ,


-- ** setEnablePreedit #method:setEnablePreedit#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextSetEnablePreeditMethodInfo,
#endif
    inputMethodContextSetEnablePreedit      ,


-- ** setInputHints #method:setInputHints#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextSetInputHintsMethodInfo,
#endif
    inputMethodContextSetInputHints         ,


-- ** setInputPurpose #method:setInputPurpose#

#if defined(ENABLE_OVERLOADING)
    InputMethodContextSetInputPurposeMethodInfo,
#endif
    inputMethodContextSetInputPurpose       ,




 -- * Properties


-- ** inputHints #attr:inputHints#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    InputMethodContextInputHintsPropertyInfo,
#endif
    constructInputMethodContextInputHints   ,
    getInputMethodContextInputHints         ,
#if defined(ENABLE_OVERLOADING)
    inputMethodContextInputHints            ,
#endif
    setInputMethodContextInputHints         ,


-- ** inputPurpose #attr:inputPurpose#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    InputMethodContextInputPurposePropertyInfo,
#endif
    constructInputMethodContextInputPurpose ,
    getInputMethodContextInputPurpose       ,
#if defined(ENABLE_OVERLOADING)
    inputMethodContextInputPurpose          ,
#endif
    setInputMethodContextInputPurpose       ,




 -- * Signals


-- ** committed #signal:committed#

    InputMethodContextCommittedCallback     ,
#if defined(ENABLE_OVERLOADING)
    InputMethodContextCommittedSignalInfo   ,
#endif
    afterInputMethodContextCommitted        ,
    onInputMethodContextCommitted           ,


-- ** deleteSurrounding #signal:deleteSurrounding#

    InputMethodContextDeleteSurroundingCallback,
#if defined(ENABLE_OVERLOADING)
    InputMethodContextDeleteSurroundingSignalInfo,
#endif
    afterInputMethodContextDeleteSurrounding,
    onInputMethodContextDeleteSurrounding   ,


-- ** preeditChanged #signal:preeditChanged#

    InputMethodContextPreeditChangedCallback,
#if defined(ENABLE_OVERLOADING)
    InputMethodContextPreeditChangedSignalInfo,
#endif
    afterInputMethodContextPreeditChanged   ,
    onInputMethodContextPreeditChanged      ,


-- ** preeditFinished #signal:preeditFinished#

    InputMethodContextPreeditFinishedCallback,
#if defined(ENABLE_OVERLOADING)
    InputMethodContextPreeditFinishedSignalInfo,
#endif
    afterInputMethodContextPreeditFinished  ,
    onInputMethodContextPreeditFinished     ,


-- ** preeditStarted #signal:preeditStarted#

    InputMethodContextPreeditStartedCallback,
#if defined(ENABLE_OVERLOADING)
    InputMethodContextPreeditStartedSignalInfo,
#endif
    afterInputMethodContextPreeditStarted   ,
    onInputMethodContextPreeditStarted      ,




    ) 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
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 Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
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 GHC.Records as R

import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Structs.EventKey as Gdk.EventKey
import {-# SOURCE #-} qualified GI.WebKit2.Enums as WebKit2.Enums
import {-# SOURCE #-} qualified GI.WebKit2.Flags as WebKit2.Flags
import {-# SOURCE #-} qualified GI.WebKit2.Structs.InputMethodUnderline as WebKit2.InputMethodUnderline

-- | Memory-managed wrapper type.
newtype InputMethodContext = InputMethodContext (SP.ManagedPtr InputMethodContext)
    deriving (InputMethodContext -> InputMethodContext -> Bool
(InputMethodContext -> InputMethodContext -> Bool)
-> (InputMethodContext -> InputMethodContext -> Bool)
-> Eq InputMethodContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InputMethodContext -> InputMethodContext -> Bool
$c/= :: InputMethodContext -> InputMethodContext -> Bool
== :: InputMethodContext -> InputMethodContext -> Bool
$c== :: InputMethodContext -> InputMethodContext -> Bool
Eq)

instance SP.ManagedPtrNewtype InputMethodContext where
    toManagedPtr :: InputMethodContext -> ManagedPtr InputMethodContext
toManagedPtr (InputMethodContext ManagedPtr InputMethodContext
p) = ManagedPtr InputMethodContext
p

foreign import ccall "webkit_input_method_context_get_type"
    c_webkit_input_method_context_get_type :: IO B.Types.GType

instance B.Types.TypedObject InputMethodContext where
    glibType :: IO GType
glibType = IO GType
c_webkit_input_method_context_get_type

instance B.Types.GObject InputMethodContext

-- | Type class for types which can be safely cast to `InputMethodContext`, for instance with `toInputMethodContext`.
class (SP.GObject o, O.IsDescendantOf InputMethodContext o) => IsInputMethodContext o
instance (SP.GObject o, O.IsDescendantOf InputMethodContext o) => IsInputMethodContext o

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

-- | Cast to `InputMethodContext`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toInputMethodContext :: (MIO.MonadIO m, IsInputMethodContext o) => o -> m InputMethodContext
toInputMethodContext :: forall (m :: * -> *) o.
(MonadIO m, IsInputMethodContext o) =>
o -> m InputMethodContext
toInputMethodContext = IO InputMethodContext -> m InputMethodContext
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InputMethodContext -> m InputMethodContext)
-> (o -> IO InputMethodContext) -> o -> m InputMethodContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr InputMethodContext -> InputMethodContext)
-> o -> IO InputMethodContext
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr InputMethodContext -> InputMethodContext
InputMethodContext

-- | Convert 'InputMethodContext' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe InputMethodContext) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_webkit_input_method_context_get_type
    gvalueSet_ :: Ptr GValue -> Maybe InputMethodContext -> IO ()
gvalueSet_ Ptr GValue
gv Maybe InputMethodContext
P.Nothing = Ptr GValue -> Ptr InputMethodContext -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr InputMethodContext
forall a. Ptr a
FP.nullPtr :: FP.Ptr InputMethodContext)
    gvalueSet_ Ptr GValue
gv (P.Just InputMethodContext
obj) = InputMethodContext -> (Ptr InputMethodContext -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr InputMethodContext
obj (Ptr GValue -> Ptr InputMethodContext -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe InputMethodContext)
gvalueGet_ Ptr GValue
gv = do
        Ptr InputMethodContext
ptr <- Ptr GValue -> IO (Ptr InputMethodContext)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr InputMethodContext)
        if Ptr InputMethodContext
ptr Ptr InputMethodContext -> Ptr InputMethodContext -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr InputMethodContext
forall a. Ptr a
FP.nullPtr
        then InputMethodContext -> Maybe InputMethodContext
forall a. a -> Maybe a
P.Just (InputMethodContext -> Maybe InputMethodContext)
-> IO InputMethodContext -> IO (Maybe InputMethodContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr InputMethodContext -> InputMethodContext)
-> Ptr InputMethodContext -> IO InputMethodContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr InputMethodContext -> InputMethodContext
InputMethodContext Ptr InputMethodContext
ptr
        else Maybe InputMethodContext -> IO (Maybe InputMethodContext)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe InputMethodContext
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveInputMethodContextMethod (t :: Symbol) (o :: *) :: * where
    ResolveInputMethodContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveInputMethodContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveInputMethodContextMethod "filterKeyEvent" o = InputMethodContextFilterKeyEventMethodInfo
    ResolveInputMethodContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveInputMethodContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveInputMethodContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveInputMethodContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveInputMethodContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveInputMethodContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveInputMethodContextMethod "notifyCursorArea" o = InputMethodContextNotifyCursorAreaMethodInfo
    ResolveInputMethodContextMethod "notifyFocusIn" o = InputMethodContextNotifyFocusInMethodInfo
    ResolveInputMethodContextMethod "notifyFocusOut" o = InputMethodContextNotifyFocusOutMethodInfo
    ResolveInputMethodContextMethod "notifySurrounding" o = InputMethodContextNotifySurroundingMethodInfo
    ResolveInputMethodContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveInputMethodContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveInputMethodContextMethod "reset" o = InputMethodContextResetMethodInfo
    ResolveInputMethodContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveInputMethodContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveInputMethodContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveInputMethodContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveInputMethodContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveInputMethodContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveInputMethodContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveInputMethodContextMethod "getInputHints" o = InputMethodContextGetInputHintsMethodInfo
    ResolveInputMethodContextMethod "getInputPurpose" o = InputMethodContextGetInputPurposeMethodInfo
    ResolveInputMethodContextMethod "getPreedit" o = InputMethodContextGetPreeditMethodInfo
    ResolveInputMethodContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveInputMethodContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveInputMethodContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveInputMethodContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveInputMethodContextMethod "setEnablePreedit" o = InputMethodContextSetEnablePreeditMethodInfo
    ResolveInputMethodContextMethod "setInputHints" o = InputMethodContextSetInputHintsMethodInfo
    ResolveInputMethodContextMethod "setInputPurpose" o = InputMethodContextSetInputPurposeMethodInfo
    ResolveInputMethodContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveInputMethodContextMethod l o = O.MethodResolutionFailed l o

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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveInputMethodContextMethod t InputMethodContext, O.OverloadedMethod info InputMethodContext p, R.HasField t InputMethodContext p) => R.HasField t InputMethodContext p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveInputMethodContextMethod t InputMethodContext, O.OverloadedMethodInfo info InputMethodContext) => OL.IsLabel t (O.MethodProxy info InputMethodContext) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif

-- signal InputMethodContext::committed
-- | Emitted when a complete input sequence has been entered by the user.
-- This can be a single character immediately after a key press or the
-- final result of preediting.
-- 
-- /Since: 2.28/
type InputMethodContextCommittedCallback =
    T.Text
    -- ^ /@text@/: the string result
    -> IO ()

type C_InputMethodContextCommittedCallback =
    Ptr InputMethodContext ->               -- object
    CString ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_InputMethodContextCommittedCallback`.
foreign import ccall "wrapper"
    mk_InputMethodContextCommittedCallback :: C_InputMethodContextCommittedCallback -> IO (FunPtr C_InputMethodContextCommittedCallback)

wrap_InputMethodContextCommittedCallback :: 
    GObject a => (a -> InputMethodContextCommittedCallback) ->
    C_InputMethodContextCommittedCallback
wrap_InputMethodContextCommittedCallback :: forall a.
GObject a =>
(a -> InputMethodContextCommittedCallback)
-> C_InputMethodContextCommittedCallback
wrap_InputMethodContextCommittedCallback a -> InputMethodContextCommittedCallback
gi'cb Ptr InputMethodContext
gi'selfPtr CString
text Ptr ()
_ = do
    Text
text' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
text
    Ptr InputMethodContext -> (InputMethodContext -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr InputMethodContext
gi'selfPtr ((InputMethodContext -> IO ()) -> IO ())
-> (InputMethodContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InputMethodContext
gi'self -> a -> InputMethodContextCommittedCallback
gi'cb (InputMethodContext -> a
Coerce.coerce InputMethodContext
gi'self)  Text
text'


-- | Connect a signal handler for the [committed](#signal:committed) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' inputMethodContext #committed callback
-- @
-- 
-- 
onInputMethodContextCommitted :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextCommittedCallback) -> m SignalHandlerId
onInputMethodContextCommitted :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a
-> ((?self::a) => InputMethodContextCommittedCallback)
-> m SignalHandlerId
onInputMethodContextCommitted a
obj (?self::a) => InputMethodContextCommittedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> InputMethodContextCommittedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => InputMethodContextCommittedCallback
InputMethodContextCommittedCallback
cb
    let wrapped' :: C_InputMethodContextCommittedCallback
wrapped' = (a -> InputMethodContextCommittedCallback)
-> C_InputMethodContextCommittedCallback
forall a.
GObject a =>
(a -> InputMethodContextCommittedCallback)
-> C_InputMethodContextCommittedCallback
wrap_InputMethodContextCommittedCallback a -> InputMethodContextCommittedCallback
wrapped
    FunPtr C_InputMethodContextCommittedCallback
wrapped'' <- C_InputMethodContextCommittedCallback
-> IO (FunPtr C_InputMethodContextCommittedCallback)
mk_InputMethodContextCommittedCallback C_InputMethodContextCommittedCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextCommittedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"committed" FunPtr C_InputMethodContextCommittedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [committed](#signal:committed) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' inputMethodContext #committed callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterInputMethodContextCommitted :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextCommittedCallback) -> m SignalHandlerId
afterInputMethodContextCommitted :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a
-> ((?self::a) => InputMethodContextCommittedCallback)
-> m SignalHandlerId
afterInputMethodContextCommitted a
obj (?self::a) => InputMethodContextCommittedCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> InputMethodContextCommittedCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => InputMethodContextCommittedCallback
InputMethodContextCommittedCallback
cb
    let wrapped' :: C_InputMethodContextCommittedCallback
wrapped' = (a -> InputMethodContextCommittedCallback)
-> C_InputMethodContextCommittedCallback
forall a.
GObject a =>
(a -> InputMethodContextCommittedCallback)
-> C_InputMethodContextCommittedCallback
wrap_InputMethodContextCommittedCallback a -> InputMethodContextCommittedCallback
wrapped
    FunPtr C_InputMethodContextCommittedCallback
wrapped'' <- C_InputMethodContextCommittedCallback
-> IO (FunPtr C_InputMethodContextCommittedCallback)
mk_InputMethodContextCommittedCallback C_InputMethodContextCommittedCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextCommittedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"committed" FunPtr C_InputMethodContextCommittedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data InputMethodContextCommittedSignalInfo
instance SignalInfo InputMethodContextCommittedSignalInfo where
    type HaskellCallbackType InputMethodContextCommittedSignalInfo = InputMethodContextCommittedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_InputMethodContextCommittedCallback cb
        cb'' <- mk_InputMethodContextCommittedCallback cb'
        connectSignalFunPtr obj "committed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext::committed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#g:signal:committed"})

#endif

-- signal InputMethodContext::delete-surrounding
-- | Emitted when the input method wants to delete the context surrounding the cursor.
-- If /@offset@/ is a negative value, it means a position before the cursor.
-- 
-- /Since: 2.28/
type InputMethodContextDeleteSurroundingCallback =
    Int32
    -- ^ /@offset@/: the character offset from the cursor position of the text to be deleted.
    -> Word32
    -- ^ /@nChars@/: the number of characters to be deleted
    -> IO ()

type C_InputMethodContextDeleteSurroundingCallback =
    Ptr InputMethodContext ->               -- object
    Int32 ->
    Word32 ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_InputMethodContextDeleteSurroundingCallback`.
foreign import ccall "wrapper"
    mk_InputMethodContextDeleteSurroundingCallback :: C_InputMethodContextDeleteSurroundingCallback -> IO (FunPtr C_InputMethodContextDeleteSurroundingCallback)

wrap_InputMethodContextDeleteSurroundingCallback :: 
    GObject a => (a -> InputMethodContextDeleteSurroundingCallback) ->
    C_InputMethodContextDeleteSurroundingCallback
wrap_InputMethodContextDeleteSurroundingCallback :: forall a.
GObject a =>
(a -> InputMethodContextDeleteSurroundingCallback)
-> C_InputMethodContextDeleteSurroundingCallback
wrap_InputMethodContextDeleteSurroundingCallback a -> InputMethodContextDeleteSurroundingCallback
gi'cb Ptr InputMethodContext
gi'selfPtr Int32
offset Word32
nChars Ptr ()
_ = do
    Ptr InputMethodContext -> (InputMethodContext -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr InputMethodContext
gi'selfPtr ((InputMethodContext -> IO ()) -> IO ())
-> (InputMethodContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InputMethodContext
gi'self -> a -> InputMethodContextDeleteSurroundingCallback
gi'cb (InputMethodContext -> a
Coerce.coerce InputMethodContext
gi'self)  Int32
offset Word32
nChars


-- | Connect a signal handler for the [deleteSurrounding](#signal:deleteSurrounding) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' inputMethodContext #deleteSurrounding callback
-- @
-- 
-- 
onInputMethodContextDeleteSurrounding :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextDeleteSurroundingCallback) -> m SignalHandlerId
onInputMethodContextDeleteSurrounding :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a
-> ((?self::a) => InputMethodContextDeleteSurroundingCallback)
-> m SignalHandlerId
onInputMethodContextDeleteSurrounding a
obj (?self::a) => InputMethodContextDeleteSurroundingCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> InputMethodContextDeleteSurroundingCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => InputMethodContextDeleteSurroundingCallback
InputMethodContextDeleteSurroundingCallback
cb
    let wrapped' :: C_InputMethodContextDeleteSurroundingCallback
wrapped' = (a -> InputMethodContextDeleteSurroundingCallback)
-> C_InputMethodContextDeleteSurroundingCallback
forall a.
GObject a =>
(a -> InputMethodContextDeleteSurroundingCallback)
-> C_InputMethodContextDeleteSurroundingCallback
wrap_InputMethodContextDeleteSurroundingCallback a -> InputMethodContextDeleteSurroundingCallback
wrapped
    FunPtr C_InputMethodContextDeleteSurroundingCallback
wrapped'' <- C_InputMethodContextDeleteSurroundingCallback
-> IO (FunPtr C_InputMethodContextDeleteSurroundingCallback)
mk_InputMethodContextDeleteSurroundingCallback C_InputMethodContextDeleteSurroundingCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextDeleteSurroundingCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"delete-surrounding" FunPtr C_InputMethodContextDeleteSurroundingCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [deleteSurrounding](#signal:deleteSurrounding) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' inputMethodContext #deleteSurrounding callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterInputMethodContextDeleteSurrounding :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextDeleteSurroundingCallback) -> m SignalHandlerId
afterInputMethodContextDeleteSurrounding :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a
-> ((?self::a) => InputMethodContextDeleteSurroundingCallback)
-> m SignalHandlerId
afterInputMethodContextDeleteSurrounding a
obj (?self::a) => InputMethodContextDeleteSurroundingCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> InputMethodContextDeleteSurroundingCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => InputMethodContextDeleteSurroundingCallback
InputMethodContextDeleteSurroundingCallback
cb
    let wrapped' :: C_InputMethodContextDeleteSurroundingCallback
wrapped' = (a -> InputMethodContextDeleteSurroundingCallback)
-> C_InputMethodContextDeleteSurroundingCallback
forall a.
GObject a =>
(a -> InputMethodContextDeleteSurroundingCallback)
-> C_InputMethodContextDeleteSurroundingCallback
wrap_InputMethodContextDeleteSurroundingCallback a -> InputMethodContextDeleteSurroundingCallback
wrapped
    FunPtr C_InputMethodContextDeleteSurroundingCallback
wrapped'' <- C_InputMethodContextDeleteSurroundingCallback
-> IO (FunPtr C_InputMethodContextDeleteSurroundingCallback)
mk_InputMethodContextDeleteSurroundingCallback C_InputMethodContextDeleteSurroundingCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextDeleteSurroundingCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"delete-surrounding" FunPtr C_InputMethodContextDeleteSurroundingCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data InputMethodContextDeleteSurroundingSignalInfo
instance SignalInfo InputMethodContextDeleteSurroundingSignalInfo where
    type HaskellCallbackType InputMethodContextDeleteSurroundingSignalInfo = InputMethodContextDeleteSurroundingCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_InputMethodContextDeleteSurroundingCallback cb
        cb'' <- mk_InputMethodContextDeleteSurroundingCallback cb'
        connectSignalFunPtr obj "delete-surrounding" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext::delete-surrounding"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#g:signal:deleteSurrounding"})

#endif

-- signal InputMethodContext::preedit-changed
-- | Emitted whenever the preedit sequence currently being entered has changed.
-- It is also emitted at the end of a preedit sequence, in which case
-- 'GI.WebKit2.Objects.InputMethodContext.inputMethodContextGetPreedit' returns the empty string.
-- 
-- /Since: 2.28/
type InputMethodContextPreeditChangedCallback =
    IO ()

type C_InputMethodContextPreeditChangedCallback =
    Ptr InputMethodContext ->               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_InputMethodContextPreeditChangedCallback`.
foreign import ccall "wrapper"
    mk_InputMethodContextPreeditChangedCallback :: C_InputMethodContextPreeditChangedCallback -> IO (FunPtr C_InputMethodContextPreeditChangedCallback)

wrap_InputMethodContextPreeditChangedCallback :: 
    GObject a => (a -> InputMethodContextPreeditChangedCallback) ->
    C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditChangedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditChangedCallback a -> IO ()
gi'cb Ptr InputMethodContext
gi'selfPtr Ptr ()
_ = do
    Ptr InputMethodContext -> (InputMethodContext -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr InputMethodContext
gi'selfPtr ((InputMethodContext -> IO ()) -> IO ())
-> (InputMethodContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InputMethodContext
gi'self -> a -> IO ()
gi'cb (InputMethodContext -> a
Coerce.coerce InputMethodContext
gi'self) 


-- | Connect a signal handler for the [preeditChanged](#signal:preeditChanged) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' inputMethodContext #preeditChanged callback
-- @
-- 
-- 
onInputMethodContextPreeditChanged :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextPreeditChangedCallback) -> m SignalHandlerId
onInputMethodContextPreeditChanged :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onInputMethodContextPreeditChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_InputMethodContextPreeditChangedCallback
wrapped' = (a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditChangedCallback a -> IO ()
wrapped
    FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' <- C_InputMethodContextPreeditChangedCallback
-> IO (FunPtr C_InputMethodContextPreeditChangedCallback)
mk_InputMethodContextPreeditChangedCallback C_InputMethodContextPreeditChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextPreeditChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"preedit-changed" FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [preeditChanged](#signal:preeditChanged) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' inputMethodContext #preeditChanged callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterInputMethodContextPreeditChanged :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextPreeditChangedCallback) -> m SignalHandlerId
afterInputMethodContextPreeditChanged :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterInputMethodContextPreeditChanged a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_InputMethodContextPreeditChangedCallback
wrapped' = (a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditChangedCallback a -> IO ()
wrapped
    FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' <- C_InputMethodContextPreeditChangedCallback
-> IO (FunPtr C_InputMethodContextPreeditChangedCallback)
mk_InputMethodContextPreeditChangedCallback C_InputMethodContextPreeditChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextPreeditChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"preedit-changed" FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data InputMethodContextPreeditChangedSignalInfo
instance SignalInfo InputMethodContextPreeditChangedSignalInfo where
    type HaskellCallbackType InputMethodContextPreeditChangedSignalInfo = InputMethodContextPreeditChangedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_InputMethodContextPreeditChangedCallback cb
        cb'' <- mk_InputMethodContextPreeditChangedCallback cb'
        connectSignalFunPtr obj "preedit-changed" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext::preedit-changed"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#g:signal:preeditChanged"})

#endif

-- signal InputMethodContext::preedit-finished
-- | Emitted when a preediting sequence has been completed or canceled.
-- 
-- /Since: 2.28/
type InputMethodContextPreeditFinishedCallback =
    IO ()

type C_InputMethodContextPreeditFinishedCallback =
    Ptr InputMethodContext ->               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_InputMethodContextPreeditFinishedCallback`.
foreign import ccall "wrapper"
    mk_InputMethodContextPreeditFinishedCallback :: C_InputMethodContextPreeditFinishedCallback -> IO (FunPtr C_InputMethodContextPreeditFinishedCallback)

wrap_InputMethodContextPreeditFinishedCallback :: 
    GObject a => (a -> InputMethodContextPreeditFinishedCallback) ->
    C_InputMethodContextPreeditFinishedCallback
wrap_InputMethodContextPreeditFinishedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditFinishedCallback a -> IO ()
gi'cb Ptr InputMethodContext
gi'selfPtr Ptr ()
_ = do
    Ptr InputMethodContext -> (InputMethodContext -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr InputMethodContext
gi'selfPtr ((InputMethodContext -> IO ()) -> IO ())
-> (InputMethodContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InputMethodContext
gi'self -> a -> IO ()
gi'cb (InputMethodContext -> a
Coerce.coerce InputMethodContext
gi'self) 


-- | Connect a signal handler for the [preeditFinished](#signal:preeditFinished) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' inputMethodContext #preeditFinished callback
-- @
-- 
-- 
onInputMethodContextPreeditFinished :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextPreeditFinishedCallback) -> m SignalHandlerId
onInputMethodContextPreeditFinished :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onInputMethodContextPreeditFinished a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_InputMethodContextPreeditChangedCallback
wrapped' = (a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditFinishedCallback a -> IO ()
wrapped
    FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' <- C_InputMethodContextPreeditChangedCallback
-> IO (FunPtr C_InputMethodContextPreeditChangedCallback)
mk_InputMethodContextPreeditFinishedCallback C_InputMethodContextPreeditChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextPreeditChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"preedit-finished" FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [preeditFinished](#signal:preeditFinished) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' inputMethodContext #preeditFinished callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterInputMethodContextPreeditFinished :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextPreeditFinishedCallback) -> m SignalHandlerId
afterInputMethodContextPreeditFinished :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterInputMethodContextPreeditFinished a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_InputMethodContextPreeditChangedCallback
wrapped' = (a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditFinishedCallback a -> IO ()
wrapped
    FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' <- C_InputMethodContextPreeditChangedCallback
-> IO (FunPtr C_InputMethodContextPreeditChangedCallback)
mk_InputMethodContextPreeditFinishedCallback C_InputMethodContextPreeditChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextPreeditChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"preedit-finished" FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data InputMethodContextPreeditFinishedSignalInfo
instance SignalInfo InputMethodContextPreeditFinishedSignalInfo where
    type HaskellCallbackType InputMethodContextPreeditFinishedSignalInfo = InputMethodContextPreeditFinishedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_InputMethodContextPreeditFinishedCallback cb
        cb'' <- mk_InputMethodContextPreeditFinishedCallback cb'
        connectSignalFunPtr obj "preedit-finished" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext::preedit-finished"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#g:signal:preeditFinished"})

#endif

-- signal InputMethodContext::preedit-started
-- | Emitted when a new preediting sequence starts.
-- 
-- /Since: 2.28/
type InputMethodContextPreeditStartedCallback =
    IO ()

type C_InputMethodContextPreeditStartedCallback =
    Ptr InputMethodContext ->               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_InputMethodContextPreeditStartedCallback`.
foreign import ccall "wrapper"
    mk_InputMethodContextPreeditStartedCallback :: C_InputMethodContextPreeditStartedCallback -> IO (FunPtr C_InputMethodContextPreeditStartedCallback)

wrap_InputMethodContextPreeditStartedCallback :: 
    GObject a => (a -> InputMethodContextPreeditStartedCallback) ->
    C_InputMethodContextPreeditStartedCallback
wrap_InputMethodContextPreeditStartedCallback :: forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditStartedCallback a -> IO ()
gi'cb Ptr InputMethodContext
gi'selfPtr Ptr ()
_ = do
    Ptr InputMethodContext -> (InputMethodContext -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr InputMethodContext
gi'selfPtr ((InputMethodContext -> IO ()) -> IO ())
-> (InputMethodContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \InputMethodContext
gi'self -> a -> IO ()
gi'cb (InputMethodContext -> a
Coerce.coerce InputMethodContext
gi'self) 


-- | Connect a signal handler for the [preeditStarted](#signal:preeditStarted) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' inputMethodContext #preeditStarted callback
-- @
-- 
-- 
onInputMethodContextPreeditStarted :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextPreeditStartedCallback) -> m SignalHandlerId
onInputMethodContextPreeditStarted :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
onInputMethodContextPreeditStarted a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_InputMethodContextPreeditChangedCallback
wrapped' = (a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditStartedCallback a -> IO ()
wrapped
    FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' <- C_InputMethodContextPreeditChangedCallback
-> IO (FunPtr C_InputMethodContextPreeditChangedCallback)
mk_InputMethodContextPreeditStartedCallback C_InputMethodContextPreeditChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextPreeditChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"preedit-started" FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [preeditStarted](#signal:preeditStarted) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' inputMethodContext #preeditStarted callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterInputMethodContextPreeditStarted :: (IsInputMethodContext a, MonadIO m) => a -> ((?self :: a) => InputMethodContextPreeditStartedCallback) -> m SignalHandlerId
afterInputMethodContextPreeditStarted :: forall a (m :: * -> *).
(IsInputMethodContext a, MonadIO m) =>
a -> ((?self::a) => IO ()) -> m SignalHandlerId
afterInputMethodContextPreeditStarted a
obj (?self::a) => IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let wrapped :: a -> IO ()
wrapped a
self = let ?self = a
?self::a
self in IO ()
(?self::a) => IO ()
cb
    let wrapped' :: C_InputMethodContextPreeditChangedCallback
wrapped' = (a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
forall a.
GObject a =>
(a -> IO ()) -> C_InputMethodContextPreeditChangedCallback
wrap_InputMethodContextPreeditStartedCallback a -> IO ()
wrapped
    FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' <- C_InputMethodContextPreeditChangedCallback
-> IO (FunPtr C_InputMethodContextPreeditChangedCallback)
mk_InputMethodContextPreeditStartedCallback C_InputMethodContextPreeditChangedCallback
wrapped'
    a
-> Text
-> FunPtr C_InputMethodContextPreeditChangedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"preedit-started" FunPtr C_InputMethodContextPreeditChangedCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data InputMethodContextPreeditStartedSignalInfo
instance SignalInfo InputMethodContextPreeditStartedSignalInfo where
    type HaskellCallbackType InputMethodContextPreeditStartedSignalInfo = InputMethodContextPreeditStartedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_InputMethodContextPreeditStartedCallback cb
        cb'' <- mk_InputMethodContextPreeditStartedCallback cb'
        connectSignalFunPtr obj "preedit-started" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext::preedit-started"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#g:signal:preeditStarted"})

#endif

-- VVV Prop "input-hints"
   -- Type: TInterface (Name {namespace = "WebKit2", name = "InputHints"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@input-hints@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputMethodContext #inputHints
-- @
getInputMethodContextInputHints :: (MonadIO m, IsInputMethodContext o) => o -> m [WebKit2.Flags.InputHints]
getInputMethodContextInputHints :: forall (m :: * -> *) o.
(MonadIO m, IsInputMethodContext o) =>
o -> m [InputHints]
getInputMethodContextInputHints o
obj = IO [InputHints] -> m [InputHints]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO [InputHints] -> m [InputHints])
-> IO [InputHints] -> m [InputHints]
forall a b. (a -> b) -> a -> b
$ o -> String -> IO [InputHints]
forall a b.
(GObject a, IsGFlag b, BoxedFlags b) =>
a -> String -> IO [b]
B.Properties.getObjectPropertyFlags o
obj String
"input-hints"

-- | Set the value of the “@input-hints@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' inputMethodContext [ #inputHints 'Data.GI.Base.Attributes.:=' value ]
-- @
setInputMethodContextInputHints :: (MonadIO m, IsInputMethodContext o) => o -> [WebKit2.Flags.InputHints] -> m ()
setInputMethodContextInputHints :: forall (m :: * -> *) o.
(MonadIO m, IsInputMethodContext o) =>
o -> [InputHints] -> m ()
setInputMethodContextInputHints o
obj [InputHints]
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> [InputHints] -> IO ()
forall a b.
(IsGFlag b, BoxedFlags b, GObject a) =>
a -> String -> [b] -> IO ()
B.Properties.setObjectPropertyFlags o
obj String
"input-hints" [InputHints]
val

-- | Construct a `GValueConstruct` with valid value for the “@input-hints@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputMethodContextInputHints :: (IsInputMethodContext o, MIO.MonadIO m) => [WebKit2.Flags.InputHints] -> m (GValueConstruct o)
constructInputMethodContextInputHints :: forall o (m :: * -> *).
(IsInputMethodContext o, MonadIO m) =>
[InputHints] -> m (GValueConstruct o)
constructInputMethodContextInputHints [InputHints]
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> [InputHints] -> IO (GValueConstruct o)
forall a o.
(IsGFlag a, BoxedFlags a) =>
String -> [a] -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyFlags String
"input-hints" [InputHints]
val

#if defined(ENABLE_OVERLOADING)
data InputMethodContextInputHintsPropertyInfo
instance AttrInfo InputMethodContextInputHintsPropertyInfo where
    type AttrAllowedOps InputMethodContextInputHintsPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InputMethodContextInputHintsPropertyInfo = IsInputMethodContext
    type AttrSetTypeConstraint InputMethodContextInputHintsPropertyInfo = (~) [WebKit2.Flags.InputHints]
    type AttrTransferTypeConstraint InputMethodContextInputHintsPropertyInfo = (~) [WebKit2.Flags.InputHints]
    type AttrTransferType InputMethodContextInputHintsPropertyInfo = [WebKit2.Flags.InputHints]
    type AttrGetType InputMethodContextInputHintsPropertyInfo = [WebKit2.Flags.InputHints]
    type AttrLabel InputMethodContextInputHintsPropertyInfo = "input-hints"
    type AttrOrigin InputMethodContextInputHintsPropertyInfo = InputMethodContext
    attrGet = getInputMethodContextInputHints
    attrSet = setInputMethodContextInputHints
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputMethodContextInputHints
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputHints"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#g:attr:inputHints"
        })
#endif

-- VVV Prop "input-purpose"
   -- Type: TInterface (Name {namespace = "WebKit2", name = "InputPurpose"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Just False)

-- | Get the value of the “@input-purpose@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' inputMethodContext #inputPurpose
-- @
getInputMethodContextInputPurpose :: (MonadIO m, IsInputMethodContext o) => o -> m WebKit2.Enums.InputPurpose
getInputMethodContextInputPurpose :: forall (m :: * -> *) o.
(MonadIO m, IsInputMethodContext o) =>
o -> m InputPurpose
getInputMethodContextInputPurpose o
obj = IO InputPurpose -> m InputPurpose
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO InputPurpose -> m InputPurpose)
-> IO InputPurpose -> m InputPurpose
forall a b. (a -> b) -> a -> b
$ o -> String -> IO InputPurpose
forall a b. (GObject a, Enum b, BoxedEnum b) => a -> String -> IO b
B.Properties.getObjectPropertyEnum o
obj String
"input-purpose"

-- | Set the value of the “@input-purpose@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' inputMethodContext [ #inputPurpose 'Data.GI.Base.Attributes.:=' value ]
-- @
setInputMethodContextInputPurpose :: (MonadIO m, IsInputMethodContext o) => o -> WebKit2.Enums.InputPurpose -> m ()
setInputMethodContextInputPurpose :: forall (m :: * -> *) o.
(MonadIO m, IsInputMethodContext o) =>
o -> InputPurpose -> m ()
setInputMethodContextInputPurpose o
obj InputPurpose
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> InputPurpose -> IO ()
forall a b.
(GObject a, Enum b, BoxedEnum b) =>
a -> String -> b -> IO ()
B.Properties.setObjectPropertyEnum o
obj String
"input-purpose" InputPurpose
val

-- | Construct a `GValueConstruct` with valid value for the “@input-purpose@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructInputMethodContextInputPurpose :: (IsInputMethodContext o, MIO.MonadIO m) => WebKit2.Enums.InputPurpose -> m (GValueConstruct o)
constructInputMethodContextInputPurpose :: forall o (m :: * -> *).
(IsInputMethodContext o, MonadIO m) =>
InputPurpose -> m (GValueConstruct o)
constructInputMethodContextInputPurpose InputPurpose
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> InputPurpose -> IO (GValueConstruct o)
forall a o.
(Enum a, BoxedEnum a) =>
String -> a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyEnum String
"input-purpose" InputPurpose
val

#if defined(ENABLE_OVERLOADING)
data InputMethodContextInputPurposePropertyInfo
instance AttrInfo InputMethodContextInputPurposePropertyInfo where
    type AttrAllowedOps InputMethodContextInputPurposePropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint InputMethodContextInputPurposePropertyInfo = IsInputMethodContext
    type AttrSetTypeConstraint InputMethodContextInputPurposePropertyInfo = (~) WebKit2.Enums.InputPurpose
    type AttrTransferTypeConstraint InputMethodContextInputPurposePropertyInfo = (~) WebKit2.Enums.InputPurpose
    type AttrTransferType InputMethodContextInputPurposePropertyInfo = WebKit2.Enums.InputPurpose
    type AttrGetType InputMethodContextInputPurposePropertyInfo = WebKit2.Enums.InputPurpose
    type AttrLabel InputMethodContextInputPurposePropertyInfo = "input-purpose"
    type AttrOrigin InputMethodContextInputPurposePropertyInfo = InputMethodContext
    attrGet = getInputMethodContextInputPurpose
    attrSet = setInputMethodContextInputPurpose
    attrTransfer _ v = do
        return v
    attrConstruct = constructInputMethodContextInputPurpose
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputPurpose"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#g:attr:inputPurpose"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList InputMethodContext
type instance O.AttributeList InputMethodContext = InputMethodContextAttributeList
type InputMethodContextAttributeList = ('[ '("inputHints", InputMethodContextInputHintsPropertyInfo), '("inputPurpose", InputMethodContextInputPurposePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
inputMethodContextInputHints :: AttrLabelProxy "inputHints"
inputMethodContextInputHints = AttrLabelProxy

inputMethodContextInputPurpose :: AttrLabelProxy "inputPurpose"
inputMethodContextInputPurpose = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList InputMethodContext = InputMethodContextSignalList
type InputMethodContextSignalList = ('[ '("committed", InputMethodContextCommittedSignalInfo), '("deleteSurrounding", InputMethodContextDeleteSurroundingSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("preeditChanged", InputMethodContextPreeditChangedSignalInfo), '("preeditFinished", InputMethodContextPreeditFinishedSignalInfo), '("preeditStarted", InputMethodContextPreeditStartedSignalInfo)] :: [(Symbol, *)])

#endif

-- method InputMethodContext::filter_key_event
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "InputMethodContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitInputMethodContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_event"
--           , argType =
--               TInterface Name { namespace = "Gdk" , name = "EventKey" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the key event to filter"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_context_filter_key_event" webkit_input_method_context_filter_key_event :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    Ptr Gdk.EventKey.EventKey ->            -- key_event : TInterface (Name {namespace = "Gdk", name = "EventKey"})
    IO CInt

-- | Allow /@keyEvent@/ to be handled by the input method. If 'P.True' is returned, then no further processing should be
-- done for the key event.
-- 
-- /Since: 2.28/
inputMethodContextFilterKeyEvent ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> Gdk.EventKey.EventKey
    -- ^ /@keyEvent@/: the key event to filter
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the key event was handled, or 'P.False' otherwise
inputMethodContextFilterKeyEvent :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> EventKey -> m Bool
inputMethodContextFilterKeyEvent a
context EventKey
keyEvent = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr EventKey
keyEvent' <- EventKey -> IO (Ptr EventKey)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr EventKey
keyEvent
    CInt
result <- Ptr InputMethodContext -> Ptr EventKey -> IO CInt
webkit_input_method_context_filter_key_event Ptr InputMethodContext
context' Ptr EventKey
keyEvent'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    EventKey -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr EventKey
keyEvent
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data InputMethodContextFilterKeyEventMethodInfo
instance (signature ~ (Gdk.EventKey.EventKey -> m Bool), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextFilterKeyEventMethodInfo a signature where
    overloadedMethod = inputMethodContextFilterKeyEvent

instance O.OverloadedMethodInfo InputMethodContextFilterKeyEventMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextFilterKeyEvent",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextFilterKeyEvent"
        })


#endif

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

foreign import ccall "webkit_input_method_context_get_input_hints" webkit_input_method_context_get_input_hints :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    IO CUInt

-- | Get the value of the t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext':@/input-hints/@ property.
-- 
-- /Since: 2.28/
inputMethodContextGetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> m [WebKit2.Flags.InputHints]
    -- ^ __Returns:__ the t'GI.WebKit2.Flags.InputHints' of the input associated with /@context@/
inputMethodContextGetInputHints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> m [InputHints]
inputMethodContextGetInputHints a
context = IO [InputHints] -> m [InputHints]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [InputHints] -> m [InputHints])
-> IO [InputHints] -> m [InputHints]
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr InputMethodContext -> IO CUInt
webkit_input_method_context_get_input_hints Ptr InputMethodContext
context'
    let result' :: [InputHints]
result' = CUInt -> [InputHints]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    [InputHints] -> IO [InputHints]
forall (m :: * -> *) a. Monad m => a -> m a
return [InputHints]
result'

#if defined(ENABLE_OVERLOADING)
data InputMethodContextGetInputHintsMethodInfo
instance (signature ~ (m [WebKit2.Flags.InputHints]), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextGetInputHintsMethodInfo a signature where
    overloadedMethod = inputMethodContextGetInputHints

instance O.OverloadedMethodInfo InputMethodContextGetInputHintsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextGetInputHints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextGetInputHints"
        })


#endif

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

foreign import ccall "webkit_input_method_context_get_input_purpose" webkit_input_method_context_get_input_purpose :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    IO CUInt

-- | Get the value of the t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext':@/input-purpose/@ property.
-- 
-- /Since: 2.28/
inputMethodContextGetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> m WebKit2.Enums.InputPurpose
    -- ^ __Returns:__ the t'GI.WebKit2.Enums.InputPurpose' of the input associated with /@context@/
inputMethodContextGetInputPurpose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> m InputPurpose
inputMethodContextGetInputPurpose a
context = IO InputPurpose -> m InputPurpose
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputPurpose -> m InputPurpose)
-> IO InputPurpose -> m InputPurpose
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CUInt
result <- Ptr InputMethodContext -> IO CUInt
webkit_input_method_context_get_input_purpose Ptr InputMethodContext
context'
    let result' :: InputPurpose
result' = (Int -> InputPurpose
forall a. Enum a => Int -> a
toEnum (Int -> InputPurpose) -> (CUInt -> Int) -> CUInt -> InputPurpose
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    InputPurpose -> IO InputPurpose
forall (m :: * -> *) a. Monad m => a -> m a
return InputPurpose
result'

#if defined(ENABLE_OVERLOADING)
data InputMethodContextGetInputPurposeMethodInfo
instance (signature ~ (m WebKit2.Enums.InputPurpose), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextGetInputPurposeMethodInfo a signature where
    overloadedMethod = inputMethodContextGetInputPurpose

instance O.OverloadedMethodInfo InputMethodContextGetInputPurposeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextGetInputPurpose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextGetInputPurpose"
        })


#endif

-- method InputMethodContext::get_preedit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "InputMethodContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitInputMethodContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the preedit string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "underlines"
--           , argType =
--               TGList
--                 (TInterface
--                    Name { namespace = "WebKit2" , name = "InputMethodUnderline" })
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the underlines as a #GList of #WebKitInputMethodUnderline"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cursor_offset"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "location to store the position of cursor in preedit string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_context_get_preedit" webkit_input_method_context_get_preedit :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    Ptr CString ->                          -- text : TBasicType TUTF8
    Ptr (Ptr (GList (Ptr WebKit2.InputMethodUnderline.InputMethodUnderline))) -> -- underlines : TGList (TInterface (Name {namespace = "WebKit2", name = "InputMethodUnderline"}))
    Ptr Word32 ->                           -- cursor_offset : TBasicType TUInt
    IO ()

-- | Get the current preedit string for the /@context@/, and a list of WebKitInputMethodUnderline to apply to the string.
-- The string will be displayed inserted at /@cursorOffset@/.
-- 
-- /Since: 2.28/
inputMethodContextGetPreedit ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> m ((Maybe T.Text, [WebKit2.InputMethodUnderline.InputMethodUnderline], Word32))
inputMethodContextGetPreedit :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> m (Maybe Text, [InputMethodUnderline], Word32)
inputMethodContextGetPreedit a
context = IO (Maybe Text, [InputMethodUnderline], Word32)
-> m (Maybe Text, [InputMethodUnderline], Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text, [InputMethodUnderline], Word32)
 -> m (Maybe Text, [InputMethodUnderline], Word32))
-> IO (Maybe Text, [InputMethodUnderline], Word32)
-> m (Maybe Text, [InputMethodUnderline], Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr CString
text <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr CString)
    Ptr (Ptr (GList (Ptr InputMethodUnderline)))
underlines <- IO (Ptr (Ptr (GList (Ptr InputMethodUnderline))))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr (GList (Ptr WebKit2.InputMethodUnderline.InputMethodUnderline))))
    Ptr Word32
cursorOffset <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr InputMethodContext
-> Ptr CString
-> Ptr (Ptr (GList (Ptr InputMethodUnderline)))
-> Ptr Word32
-> IO ()
webkit_input_method_context_get_preedit Ptr InputMethodContext
context' Ptr CString
text Ptr (Ptr (GList (Ptr InputMethodUnderline)))
underlines Ptr Word32
cursorOffset
    CString
text' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
text
    Maybe Text
maybeText' <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
text' ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
text'' -> do
        Text
text''' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
text''
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
text'''
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    Ptr (GList (Ptr InputMethodUnderline))
underlines' <- Ptr (Ptr (GList (Ptr InputMethodUnderline)))
-> IO (Ptr (GList (Ptr InputMethodUnderline)))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GList (Ptr InputMethodUnderline)))
underlines
    [Ptr InputMethodUnderline]
underlines'' <- Ptr (GList (Ptr InputMethodUnderline))
-> IO [Ptr InputMethodUnderline]
forall a. Ptr (GList (Ptr a)) -> IO [Ptr a]
unpackGList Ptr (GList (Ptr InputMethodUnderline))
underlines'
    [InputMethodUnderline]
underlines''' <- (Ptr InputMethodUnderline -> IO InputMethodUnderline)
-> [Ptr InputMethodUnderline] -> IO [InputMethodUnderline]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr InputMethodUnderline -> InputMethodUnderline)
-> Ptr InputMethodUnderline -> IO InputMethodUnderline
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr InputMethodUnderline -> InputMethodUnderline
WebKit2.InputMethodUnderline.InputMethodUnderline) [Ptr InputMethodUnderline]
underlines''
    Ptr (GList (Ptr InputMethodUnderline)) -> IO ()
forall a. Ptr (GList a) -> IO ()
g_list_free Ptr (GList (Ptr InputMethodUnderline))
underlines'
    Word32
cursorOffset' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
cursorOffset
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
text
    Ptr (Ptr (GList (Ptr InputMethodUnderline))) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GList (Ptr InputMethodUnderline)))
underlines
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
cursorOffset
    (Maybe Text, [InputMethodUnderline], Word32)
-> IO (Maybe Text, [InputMethodUnderline], Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text
maybeText', [InputMethodUnderline]
underlines''', Word32
cursorOffset')

#if defined(ENABLE_OVERLOADING)
data InputMethodContextGetPreeditMethodInfo
instance (signature ~ (m ((Maybe T.Text, [WebKit2.InputMethodUnderline.InputMethodUnderline], Word32))), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextGetPreeditMethodInfo a signature where
    overloadedMethod = inputMethodContextGetPreedit

instance O.OverloadedMethodInfo InputMethodContextGetPreeditMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextGetPreedit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextGetPreedit"
        })


#endif

-- method InputMethodContext::notify_cursor_area
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "InputMethodContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitInputMethodContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "x"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the x coordinate of cursor location"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "y"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the y coordinate of cursor location"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "width"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the width of cursor area"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "height"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the height of cursor area"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_context_notify_cursor_area" webkit_input_method_context_notify_cursor_area :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    Int32 ->                                -- x : TBasicType TInt
    Int32 ->                                -- y : TBasicType TInt
    Int32 ->                                -- width : TBasicType TInt
    Int32 ->                                -- height : TBasicType TInt
    IO ()

-- | Notify /@context@/ that cursor area changed in input associated.
-- 
-- /Since: 2.28/
inputMethodContextNotifyCursorArea ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> Int32
    -- ^ /@x@/: the x coordinate of cursor location
    -> Int32
    -- ^ /@y@/: the y coordinate of cursor location
    -> Int32
    -- ^ /@width@/: the width of cursor area
    -> Int32
    -- ^ /@height@/: the height of cursor area
    -> m ()
inputMethodContextNotifyCursorArea :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> Int32 -> Int32 -> Int32 -> Int32 -> m ()
inputMethodContextNotifyCursorArea a
context Int32
x Int32
y Int32
width Int32
height = 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 InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr InputMethodContext -> Int32 -> Int32 -> Int32 -> Int32 -> IO ()
webkit_input_method_context_notify_cursor_area Ptr InputMethodContext
context' Int32
x Int32
y Int32
width Int32
height
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodContextNotifyCursorAreaMethodInfo
instance (signature ~ (Int32 -> Int32 -> Int32 -> Int32 -> m ()), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextNotifyCursorAreaMethodInfo a signature where
    overloadedMethod = inputMethodContextNotifyCursorArea

instance O.OverloadedMethodInfo InputMethodContextNotifyCursorAreaMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextNotifyCursorArea",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextNotifyCursorArea"
        })


#endif

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

foreign import ccall "webkit_input_method_context_notify_focus_in" webkit_input_method_context_notify_focus_in :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    IO ()

-- | Notify /@context@/ that input associated has gained focus.
-- 
-- /Since: 2.28/
inputMethodContextNotifyFocusIn ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> m ()
inputMethodContextNotifyFocusIn :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> m ()
inputMethodContextNotifyFocusIn a
context = 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 InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr InputMethodContext -> IO ()
webkit_input_method_context_notify_focus_in Ptr InputMethodContext
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodContextNotifyFocusInMethodInfo
instance (signature ~ (m ()), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextNotifyFocusInMethodInfo a signature where
    overloadedMethod = inputMethodContextNotifyFocusIn

instance O.OverloadedMethodInfo InputMethodContextNotifyFocusInMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextNotifyFocusIn",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextNotifyFocusIn"
        })


#endif

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

foreign import ccall "webkit_input_method_context_notify_focus_out" webkit_input_method_context_notify_focus_out :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    IO ()

-- | Notify /@context@/ that input associated has lost focus.
-- 
-- /Since: 2.28/
inputMethodContextNotifyFocusOut ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> m ()
inputMethodContextNotifyFocusOut :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> m ()
inputMethodContextNotifyFocusOut a
context = 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 InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr InputMethodContext -> IO ()
webkit_input_method_context_notify_focus_out Ptr InputMethodContext
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodContextNotifyFocusOutMethodInfo
instance (signature ~ (m ()), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextNotifyFocusOutMethodInfo a signature where
    overloadedMethod = inputMethodContextNotifyFocusOut

instance O.OverloadedMethodInfo InputMethodContextNotifyFocusOutMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextNotifyFocusOut",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextNotifyFocusOut"
        })


#endif

-- method InputMethodContext::notify_surrounding
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "InputMethodContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitInputMethodContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "text"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "text surrounding the insertion point"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the length of @text, or -1 if @text is nul-terminated"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cursor_index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the byte index of the insertion cursor within @text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "selection_index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the byte index of the selection cursor within @text."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_context_notify_surrounding" webkit_input_method_context_notify_surrounding :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    CString ->                              -- text : TBasicType TUTF8
    Int32 ->                                -- length : TBasicType TInt
    Word32 ->                               -- cursor_index : TBasicType TUInt
    Word32 ->                               -- selection_index : TBasicType TUInt
    IO ()

-- | Notify /@context@/ that the context surrounding the cursor has changed.
-- If there\'s no selection /@selectionIndex@/ is the same as /@cursorIndex@/.
-- 
-- /Since: 2.28/
inputMethodContextNotifySurrounding ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> T.Text
    -- ^ /@text@/: text surrounding the insertion point
    -> Int32
    -- ^ /@length@/: the length of /@text@/, or -1 if /@text@/ is nul-terminated
    -> Word32
    -- ^ /@cursorIndex@/: the byte index of the insertion cursor within /@text@/.
    -> Word32
    -- ^ /@selectionIndex@/: the byte index of the selection cursor within /@text@/.
    -> m ()
inputMethodContextNotifySurrounding :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> Text -> Int32 -> Word32 -> Word32 -> m ()
inputMethodContextNotifySurrounding a
context Text
text Int32
length_ Word32
cursorIndex Word32
selectionIndex = 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 InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    CString
text' <- Text -> IO CString
textToCString Text
text
    Ptr InputMethodContext
-> CString -> Int32 -> Word32 -> Word32 -> IO ()
webkit_input_method_context_notify_surrounding Ptr InputMethodContext
context' CString
text' Int32
length_ Word32
cursorIndex Word32
selectionIndex
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
text'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodContextNotifySurroundingMethodInfo
instance (signature ~ (T.Text -> Int32 -> Word32 -> Word32 -> m ()), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextNotifySurroundingMethodInfo a signature where
    overloadedMethod = inputMethodContextNotifySurrounding

instance O.OverloadedMethodInfo InputMethodContextNotifySurroundingMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextNotifySurrounding",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextNotifySurrounding"
        })


#endif

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

foreign import ccall "webkit_input_method_context_reset" webkit_input_method_context_reset :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    IO ()

-- | Reset the /@context@/. This will typically cause the input to clear the preedit state.
-- 
-- /Since: 2.28/
inputMethodContextReset ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> m ()
inputMethodContextReset :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> m ()
inputMethodContextReset a
context = 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 InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    Ptr InputMethodContext -> IO ()
webkit_input_method_context_reset Ptr InputMethodContext
context'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodContextResetMethodInfo
instance (signature ~ (m ()), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextResetMethodInfo a signature where
    overloadedMethod = inputMethodContextReset

instance O.OverloadedMethodInfo InputMethodContextResetMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextReset",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextReset"
        })


#endif

-- method InputMethodContext::set_enable_preedit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "InputMethodContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitInputMethodContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "whether to enable preedit"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_context_set_enable_preedit" webkit_input_method_context_set_enable_preedit :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Set whether /@context@/ should enable preedit to display feedback.
-- 
-- /Since: 2.28/
inputMethodContextSetEnablePreedit ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> Bool
    -- ^ /@enabled@/: whether to enable preedit
    -> m ()
inputMethodContextSetEnablePreedit :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> Bool -> m ()
inputMethodContextSetEnablePreedit a
context Bool
enabled = 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 InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enabled
    Ptr InputMethodContext -> CInt -> IO ()
webkit_input_method_context_set_enable_preedit Ptr InputMethodContext
context' CInt
enabled'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodContextSetEnablePreeditMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextSetEnablePreeditMethodInfo a signature where
    overloadedMethod = inputMethodContextSetEnablePreedit

instance O.OverloadedMethodInfo InputMethodContextSetEnablePreeditMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextSetEnablePreedit",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextSetEnablePreedit"
        })


#endif

-- method InputMethodContext::set_input_hints
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "context"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "InputMethodContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "hints"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "InputHints" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_input_method_context_set_input_hints" webkit_input_method_context_set_input_hints :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    CUInt ->                                -- hints : TInterface (Name {namespace = "WebKit2", name = "InputHints"})
    IO ()

-- | /No description available in the introspection data./
inputMethodContextSetInputHints ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -> [WebKit2.Flags.InputHints]
    -> m ()
inputMethodContextSetInputHints :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> [InputHints] -> m ()
inputMethodContextSetInputHints a
context [InputHints]
hints = 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 InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let hints' :: CUInt
hints' = [InputHints] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [InputHints]
hints
    Ptr InputMethodContext -> CUInt -> IO ()
webkit_input_method_context_set_input_hints Ptr InputMethodContext
context' CUInt
hints'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodContextSetInputHintsMethodInfo
instance (signature ~ ([WebKit2.Flags.InputHints] -> m ()), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextSetInputHintsMethodInfo a signature where
    overloadedMethod = inputMethodContextSetInputHints

instance O.OverloadedMethodInfo InputMethodContextSetInputHintsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextSetInputHints",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextSetInputHints"
        })


#endif

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

foreign import ccall "webkit_input_method_context_set_input_purpose" webkit_input_method_context_set_input_purpose :: 
    Ptr InputMethodContext ->               -- context : TInterface (Name {namespace = "WebKit2", name = "InputMethodContext"})
    CUInt ->                                -- purpose : TInterface (Name {namespace = "WebKit2", name = "InputPurpose"})
    IO ()

-- | Set the value of the t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext':@/input-purpose/@ property.
-- 
-- /Since: 2.28/
inputMethodContextSetInputPurpose ::
    (B.CallStack.HasCallStack, MonadIO m, IsInputMethodContext a) =>
    a
    -- ^ /@context@/: a t'GI.WebKit2.Objects.InputMethodContext.InputMethodContext'
    -> WebKit2.Enums.InputPurpose
    -- ^ /@purpose@/: a t'GI.WebKit2.Enums.InputPurpose'
    -> m ()
inputMethodContextSetInputPurpose :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsInputMethodContext a) =>
a -> InputPurpose -> m ()
inputMethodContextSetInputPurpose a
context InputPurpose
purpose = 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 InputMethodContext
context' <- a -> IO (Ptr InputMethodContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
context
    let purpose' :: CUInt
purpose' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (InputPurpose -> Int) -> InputPurpose -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InputPurpose -> Int
forall a. Enum a => a -> Int
fromEnum) InputPurpose
purpose
    Ptr InputMethodContext -> CUInt -> IO ()
webkit_input_method_context_set_input_purpose Ptr InputMethodContext
context' CUInt
purpose'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
context
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data InputMethodContextSetInputPurposeMethodInfo
instance (signature ~ (WebKit2.Enums.InputPurpose -> m ()), MonadIO m, IsInputMethodContext a) => O.OverloadedMethod InputMethodContextSetInputPurposeMethodInfo a signature where
    overloadedMethod = inputMethodContextSetInputPurpose

instance O.OverloadedMethodInfo InputMethodContextSetInputPurposeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.WebKit2.Objects.InputMethodContext.inputMethodContextSetInputPurpose",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.28/docs/GI-WebKit2-Objects-InputMethodContext.html#v:inputMethodContextSetInputPurpose"
        })


#endif