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


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Vim emulation.
-- 
-- The @GtkSourceVimIMContext@ is a t'GI.Gtk.Objects.IMContext.IMContext' implementation that can
-- be used to provide Vim-like editing controls within a [class/@view@/].
-- 
-- The @GtkSourceViMIMContext@ will process incoming t'GI.Gdk.Objects.KeyEvent.KeyEvent' as the
-- user types. It should be used in conjunction with a t'GI.Gtk.Objects.EventControllerKey.EventControllerKey'.
-- 
-- Various features supported by @GtkSourceVimIMContext@ include:
-- 
--  - Normal, Insert, Replace, Visual, and Visual Line modes
--  - Support for an integrated command bar and current command preview
--  - Search and replace
--  - Motions and Text Objects
--  - History replay
--  - Jumplists within the current file
--  - Registers including the system and primary clipboards
--  - Creation and motion to marks
--  - Some commonly used Vim commands
-- 
-- It is recommended that applications display the contents of
-- [property/@vimIMContext@/:command-bar-text] and
-- [property/@vimIMContext@/:command-text] to the user as they represent the
-- command-bar and current command preview found in Vim.
-- 
-- @GtkSourceVimIMContext@ attempts to work with additional t'GI.Gtk.Objects.IMContext.IMContext'
-- implementations such as IBus by querying the t'GI.Gtk.Objects.TextView.TextView' before processing
-- the command in states which support it (notably Insert and Replace modes).
-- 
-- 
-- === /c code/
-- >GtkEventController *key;
-- >GtkIMContext *im_context;
-- >GtkWidget *view;
-- >
-- >view = gtk_source_view_new ();
-- >im_context = gtk_source_vim_im_context_new ();
-- >key = gtk_event_controller_key_new ();
-- >
-- >gtk_event_controller_key_set_im_context (GTK_EVENT_CONTROLLER_KEY (key), im_context);
-- >gtk_event_controller_set_propagation_phase (key, GTK_PHASE_CAPTURE);
-- >gtk_widget_add_controller (view, key);
-- >gtk_im_context_set_client_widget (im_context, view);
-- >
-- >g_object_bind_property (im_context, "command-bar-text", command_bar_label, "label", 0);
-- >g_object_bind_property (im_context, "command-text", command_label, "label", 0);
-- 
-- 
-- /Since: 5.4/

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

module GI.GtkSource.Objects.VimIMContext
    ( 

-- * Exported types
    VimIMContext(..)                        ,
    IsVimIMContext                          ,
    toVimIMContext                          ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [activateOsk]("GI.Gtk.Objects.IMContext#g:method:activateOsk"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [deleteSurrounding]("GI.Gtk.Objects.IMContext#g:method:deleteSurrounding"), [executeCommand]("GI.GtkSource.Objects.VimIMContext#g:method:executeCommand"), [filterKey]("GI.Gtk.Objects.IMContext#g:method:filterKey"), [filterKeypress]("GI.Gtk.Objects.IMContext#g:method:filterKeypress"), [focusIn]("GI.Gtk.Objects.IMContext#g:method:focusIn"), [focusOut]("GI.Gtk.Objects.IMContext#g:method:focusOut"), [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"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [reset]("GI.Gtk.Objects.IMContext#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
-- [getCommandBarText]("GI.GtkSource.Objects.VimIMContext#g:method:getCommandBarText"), [getCommandText]("GI.GtkSource.Objects.VimIMContext#g:method:getCommandText"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getPreeditString]("GI.Gtk.Objects.IMContext#g:method:getPreeditString"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getSurrounding]("GI.Gtk.Objects.IMContext#g:method:getSurrounding"), [getSurroundingWithSelection]("GI.Gtk.Objects.IMContext#g:method:getSurroundingWithSelection").
-- 
-- ==== Setters
-- [setClientWidget]("GI.Gtk.Objects.IMContext#g:method:setClientWidget"), [setCursorLocation]("GI.Gtk.Objects.IMContext#g:method:setCursorLocation"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setSurrounding]("GI.Gtk.Objects.IMContext#g:method:setSurrounding"), [setSurroundingWithSelection]("GI.Gtk.Objects.IMContext#g:method:setSurroundingWithSelection"), [setUsePreedit]("GI.Gtk.Objects.IMContext#g:method:setUsePreedit").

#if defined(ENABLE_OVERLOADING)
    ResolveVimIMContextMethod               ,
#endif

-- ** executeCommand #method:executeCommand#

#if defined(ENABLE_OVERLOADING)
    VimIMContextExecuteCommandMethodInfo    ,
#endif
    vimIMContextExecuteCommand              ,


-- ** getCommandBarText #method:getCommandBarText#

#if defined(ENABLE_OVERLOADING)
    VimIMContextGetCommandBarTextMethodInfo ,
#endif
    vimIMContextGetCommandBarText           ,


-- ** getCommandText #method:getCommandText#

#if defined(ENABLE_OVERLOADING)
    VimIMContextGetCommandTextMethodInfo    ,
#endif
    vimIMContextGetCommandText              ,


-- ** new #method:new#

    vimIMContextNew                         ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    VimIMContextCommandBarTextPropertyInfo  ,
#endif
    getVimIMContextCommandBarText           ,
#if defined(ENABLE_OVERLOADING)
    vimIMContextCommandBarText              ,
#endif


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

#if defined(ENABLE_OVERLOADING)
    VimIMContextCommandTextPropertyInfo     ,
#endif
    getVimIMContextCommandText              ,
#if defined(ENABLE_OVERLOADING)
    vimIMContextCommandText                 ,
#endif




 -- * Signals


-- ** edit #signal:edit#

    VimIMContextEditCallback                ,
#if defined(ENABLE_OVERLOADING)
    VimIMContextEditSignalInfo              ,
#endif
    afterVimIMContextEdit                   ,
    onVimIMContextEdit                      ,


-- ** executeCommand #signal:executeCommand#

    VimIMContextExecuteCommandCallback      ,
#if defined(ENABLE_OVERLOADING)
    VimIMContextExecuteCommandSignalInfo    ,
#endif
    afterVimIMContextExecuteCommand         ,
    onVimIMContextExecuteCommand            ,


-- ** formatText #signal:formatText#

    VimIMContextFormatTextCallback          ,
#if defined(ENABLE_OVERLOADING)
    VimIMContextFormatTextSignalInfo        ,
#endif
    afterVimIMContextFormatText             ,
    onVimIMContextFormatText                ,


-- ** write #signal:write#

    VimIMContextWriteCallback               ,
#if defined(ENABLE_OVERLOADING)
    VimIMContextWriteSignalInfo             ,
#endif
    afterVimIMContextWrite                  ,
    onVimIMContextWrite                     ,




    ) 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.GHashTable as B.GHT
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.Kind as DK
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 Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gdk.Flags as Gdk.Flags
import qualified GI.Gdk.Interfaces.Paintable as Gdk.Paintable
import qualified GI.Gdk.Structs.RGBA as Gdk.RGBA
import qualified GI.Gdk.Structs.Rectangle as Gdk.Rectangle
import qualified GI.GdkPixbuf.Objects.Pixbuf as GdkPixbuf.Pixbuf
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Flags as Gio.Flags
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Icon as Gio.Icon
import qualified GI.Gio.Interfaces.ListModel as Gio.ListModel
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.Settings as Gio.Settings
import qualified GI.Gtk.Enums as Gtk.Enums
import qualified GI.Gtk.Interfaces.Accessible as Gtk.Accessible
import qualified GI.Gtk.Interfaces.AccessibleText as Gtk.AccessibleText
import qualified GI.Gtk.Interfaces.Buildable as Gtk.Buildable
import qualified GI.Gtk.Interfaces.ConstraintTarget as Gtk.ConstraintTarget
import qualified GI.Gtk.Interfaces.Scrollable as Gtk.Scrollable
import qualified GI.Gtk.Objects.IMContext as Gtk.IMContext
import qualified GI.Gtk.Objects.TextBuffer as Gtk.TextBuffer
import qualified GI.Gtk.Objects.TextMark as Gtk.TextMark
import qualified GI.Gtk.Objects.TextTag as Gtk.TextTag
import qualified GI.Gtk.Objects.TextTagTable as Gtk.TextTagTable
import qualified GI.Gtk.Objects.TextView as Gtk.TextView
import qualified GI.Gtk.Objects.Widget as Gtk.Widget
import qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.GtkSource.Enums as GtkSource.Enums
import {-# SOURCE #-} qualified GI.GtkSource.Flags as GtkSource.Flags
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.CompletionProposal as GtkSource.CompletionProposal
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.CompletionProvider as GtkSource.CompletionProvider
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.HoverProvider as GtkSource.HoverProvider
import {-# SOURCE #-} qualified GI.GtkSource.Interfaces.Indenter as GtkSource.Indenter
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Buffer as GtkSource.Buffer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Completion as GtkSource.Completion
import {-# SOURCE #-} qualified GI.GtkSource.Objects.CompletionCell as GtkSource.CompletionCell
import {-# SOURCE #-} qualified GI.GtkSource.Objects.CompletionContext as GtkSource.CompletionContext
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Gutter as GtkSource.Gutter
import {-# SOURCE #-} qualified GI.GtkSource.Objects.GutterLines as GtkSource.GutterLines
import {-# SOURCE #-} qualified GI.GtkSource.Objects.GutterRenderer as GtkSource.GutterRenderer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Hover as GtkSource.Hover
import {-# SOURCE #-} qualified GI.GtkSource.Objects.HoverContext as GtkSource.HoverContext
import {-# SOURCE #-} qualified GI.GtkSource.Objects.HoverDisplay as GtkSource.HoverDisplay
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Language as GtkSource.Language
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Mark as GtkSource.Mark
import {-# SOURCE #-} qualified GI.GtkSource.Objects.MarkAttributes as GtkSource.MarkAttributes
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Snippet as GtkSource.Snippet
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SnippetChunk as GtkSource.SnippetChunk
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SnippetContext as GtkSource.SnippetContext
import {-# SOURCE #-} qualified GI.GtkSource.Objects.SpaceDrawer as GtkSource.SpaceDrawer
import {-# SOURCE #-} qualified GI.GtkSource.Objects.Style as GtkSource.Style
import {-# SOURCE #-} qualified GI.GtkSource.Objects.StyleScheme as GtkSource.StyleScheme
import {-# SOURCE #-} qualified GI.GtkSource.Objects.View as GtkSource.View
import qualified GI.Pango.Enums as Pango.Enums
import qualified GI.Pango.Structs.AttrList as Pango.AttrList

#else
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gtk.Objects.IMContext as Gtk.IMContext
import qualified GI.Gtk.Structs.TextIter as Gtk.TextIter
import {-# SOURCE #-} qualified GI.GtkSource.Objects.View as GtkSource.View

#endif

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

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

foreign import ccall "gtk_source_vim_im_context_get_type"
    c_gtk_source_vim_im_context_get_type :: IO B.Types.GType

instance B.Types.TypedObject VimIMContext where
    glibType :: IO GType
glibType = IO GType
c_gtk_source_vim_im_context_get_type

instance B.Types.GObject VimIMContext

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

instance O.HasParentTypes VimIMContext
type instance O.ParentTypes VimIMContext = '[Gtk.IMContext.IMContext, GObject.Object.Object]

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

-- | Convert 'VimIMContext' 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 VimIMContext) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_gtk_source_vim_im_context_get_type
    gvalueSet_ :: Ptr GValue -> Maybe VimIMContext -> IO ()
gvalueSet_ Ptr GValue
gv Maybe VimIMContext
P.Nothing = Ptr GValue -> Ptr VimIMContext -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr VimIMContext
forall a. Ptr a
FP.nullPtr :: FP.Ptr VimIMContext)
    gvalueSet_ Ptr GValue
gv (P.Just VimIMContext
obj) = VimIMContext -> (Ptr VimIMContext -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr VimIMContext
obj (Ptr GValue -> Ptr VimIMContext -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe VimIMContext)
gvalueGet_ Ptr GValue
gv = do
        Ptr VimIMContext
ptr <- Ptr GValue -> IO (Ptr VimIMContext)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr VimIMContext)
        if Ptr VimIMContext
ptr Ptr VimIMContext -> Ptr VimIMContext -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr VimIMContext
forall a. Ptr a
FP.nullPtr
        then VimIMContext -> Maybe VimIMContext
forall a. a -> Maybe a
P.Just (VimIMContext -> Maybe VimIMContext)
-> IO VimIMContext -> IO (Maybe VimIMContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr VimIMContext -> VimIMContext)
-> Ptr VimIMContext -> IO VimIMContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr VimIMContext -> VimIMContext
VimIMContext Ptr VimIMContext
ptr
        else Maybe VimIMContext -> IO (Maybe VimIMContext)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe VimIMContext
forall a. Maybe a
P.Nothing
        
    

#if defined(ENABLE_OVERLOADING)
type family ResolveVimIMContextMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveVimIMContextMethod "activateOsk" o = Gtk.IMContext.IMContextActivateOskMethodInfo
    ResolveVimIMContextMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveVimIMContextMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveVimIMContextMethod "deleteSurrounding" o = Gtk.IMContext.IMContextDeleteSurroundingMethodInfo
    ResolveVimIMContextMethod "executeCommand" o = VimIMContextExecuteCommandMethodInfo
    ResolveVimIMContextMethod "filterKey" o = Gtk.IMContext.IMContextFilterKeyMethodInfo
    ResolveVimIMContextMethod "filterKeypress" o = Gtk.IMContext.IMContextFilterKeypressMethodInfo
    ResolveVimIMContextMethod "focusIn" o = Gtk.IMContext.IMContextFocusInMethodInfo
    ResolveVimIMContextMethod "focusOut" o = Gtk.IMContext.IMContextFocusOutMethodInfo
    ResolveVimIMContextMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveVimIMContextMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveVimIMContextMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveVimIMContextMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveVimIMContextMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveVimIMContextMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveVimIMContextMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveVimIMContextMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveVimIMContextMethod "reset" o = Gtk.IMContext.IMContextResetMethodInfo
    ResolveVimIMContextMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveVimIMContextMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveVimIMContextMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveVimIMContextMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveVimIMContextMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveVimIMContextMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveVimIMContextMethod "getCommandBarText" o = VimIMContextGetCommandBarTextMethodInfo
    ResolveVimIMContextMethod "getCommandText" o = VimIMContextGetCommandTextMethodInfo
    ResolveVimIMContextMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveVimIMContextMethod "getPreeditString" o = Gtk.IMContext.IMContextGetPreeditStringMethodInfo
    ResolveVimIMContextMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveVimIMContextMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveVimIMContextMethod "getSurrounding" o = Gtk.IMContext.IMContextGetSurroundingMethodInfo
    ResolveVimIMContextMethod "getSurroundingWithSelection" o = Gtk.IMContext.IMContextGetSurroundingWithSelectionMethodInfo
    ResolveVimIMContextMethod "setClientWidget" o = Gtk.IMContext.IMContextSetClientWidgetMethodInfo
    ResolveVimIMContextMethod "setCursorLocation" o = Gtk.IMContext.IMContextSetCursorLocationMethodInfo
    ResolveVimIMContextMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveVimIMContextMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveVimIMContextMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveVimIMContextMethod "setSurrounding" o = Gtk.IMContext.IMContextSetSurroundingMethodInfo
    ResolveVimIMContextMethod "setSurroundingWithSelection" o = Gtk.IMContext.IMContextSetSurroundingWithSelectionMethodInfo
    ResolveVimIMContextMethod "setUsePreedit" o = Gtk.IMContext.IMContextSetUsePreeditMethodInfo
    ResolveVimIMContextMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveVimIMContextMethod t VimIMContext, O.OverloadedMethod info VimIMContext p) => OL.IsLabel t (VimIMContext -> 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 ~ ResolveVimIMContextMethod t VimIMContext, O.OverloadedMethod info VimIMContext p, R.HasField t VimIMContext p) => R.HasField t VimIMContext p where
    getField = O.overloadedMethod @info

#endif

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

#endif

-- signal VimIMContext::edit
-- | Requests the application open the file found at /@path@/.
-- 
-- If /@path@/ is 'P.Nothing', then the current file should be reloaded from storage.
-- 
-- This may be executed in relation to the user running the
-- @:edit@ or @:e@ commands.
-- 
-- /Since: 5.4/
type VimIMContextEditCallback =
    GtkSource.View.View
    -- ^ /@view@/: the t'GI.GtkSource.Objects.View.View'
    -> Maybe T.Text
    -- ^ /@path@/: the path if provided, otherwise 'P.Nothing'
    -> IO ()

type C_VimIMContextEditCallback =
    Ptr VimIMContext ->                     -- object
    Ptr GtkSource.View.View ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VimIMContextEditCallback :: 
    GObject a => (a -> VimIMContextEditCallback) ->
    C_VimIMContextEditCallback
wrap_VimIMContextEditCallback :: forall a.
GObject a =>
(a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
wrap_VimIMContextEditCallback a -> VimIMContextEditCallback
gi'cb Ptr VimIMContext
gi'selfPtr Ptr View
view CString
path Ptr ()
_ = do
    View
view' <- ((ManagedPtr View -> View) -> Ptr View -> IO View
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr View -> View
GtkSource.View.View) Ptr View
view
    Maybe Text
maybePath <-
        if CString
path CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
        then Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        else do
            Text
path' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
path
            Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
path'
    Ptr VimIMContext -> (VimIMContext -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VimIMContext
gi'selfPtr ((VimIMContext -> IO ()) -> IO ())
-> (VimIMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VimIMContext
gi'self -> a -> VimIMContextEditCallback
gi'cb (VimIMContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VimIMContext
gi'self)  View
view' Maybe Text
maybePath


-- | Connect a signal handler for the [edit](#signal:edit) 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' vimIMContext #edit callback
-- @
-- 
-- 
onVimIMContextEdit :: (IsVimIMContext a, MonadIO m) => a -> ((?self :: a) => VimIMContextEditCallback) -> m SignalHandlerId
onVimIMContextEdit :: forall a (m :: * -> *).
(IsVimIMContext a, MonadIO m) =>
a -> ((?self::a) => VimIMContextEditCallback) -> m SignalHandlerId
onVimIMContextEdit a
obj (?self::a) => VimIMContextEditCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> VimIMContextEditCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VimIMContextEditCallback
VimIMContextEditCallback
cb
    let wrapped' :: C_VimIMContextEditCallback
wrapped' = (a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
forall a.
GObject a =>
(a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
wrap_VimIMContextEditCallback a -> VimIMContextEditCallback
wrapped
    FunPtr C_VimIMContextEditCallback
wrapped'' <- C_VimIMContextEditCallback
-> IO (FunPtr C_VimIMContextEditCallback)
mk_VimIMContextEditCallback C_VimIMContextEditCallback
wrapped'
    a
-> Text
-> FunPtr C_VimIMContextEditCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"edit" FunPtr C_VimIMContextEditCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [edit](#signal:edit) 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' vimIMContext #edit 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.
-- 
afterVimIMContextEdit :: (IsVimIMContext a, MonadIO m) => a -> ((?self :: a) => VimIMContextEditCallback) -> m SignalHandlerId
afterVimIMContextEdit :: forall a (m :: * -> *).
(IsVimIMContext a, MonadIO m) =>
a -> ((?self::a) => VimIMContextEditCallback) -> m SignalHandlerId
afterVimIMContextEdit a
obj (?self::a) => VimIMContextEditCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> VimIMContextEditCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VimIMContextEditCallback
VimIMContextEditCallback
cb
    let wrapped' :: C_VimIMContextEditCallback
wrapped' = (a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
forall a.
GObject a =>
(a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
wrap_VimIMContextEditCallback a -> VimIMContextEditCallback
wrapped
    FunPtr C_VimIMContextEditCallback
wrapped'' <- C_VimIMContextEditCallback
-> IO (FunPtr C_VimIMContextEditCallback)
mk_VimIMContextEditCallback C_VimIMContextEditCallback
wrapped'
    a
-> Text
-> FunPtr C_VimIMContextEditCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"edit" FunPtr C_VimIMContextEditCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VimIMContextEditSignalInfo
instance SignalInfo VimIMContextEditSignalInfo where
    type HaskellCallbackType VimIMContextEditSignalInfo = VimIMContextEditCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VimIMContextEditCallback cb
        cb'' <- mk_VimIMContextEditCallback cb'
        connectSignalFunPtr obj "edit" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext::edit"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#g:signal:edit"})

#endif

-- signal VimIMContext::execute-command
-- | The signal is emitted when a command should be
-- executed. This might be something like @:wq@ or @:e \<path>@.
-- 
-- If the application chooses to implement this, it should return
-- 'P.True' from this signal to indicate the command has been handled.
-- 
-- /Since: 5.4/
type VimIMContextExecuteCommandCallback =
    T.Text
    -- ^ /@command@/: the command to execute
    -> IO Bool
    -- ^ __Returns:__ 'P.True' if handled; otherwise 'P.False'.

type C_VimIMContextExecuteCommandCallback =
    Ptr VimIMContext ->                     -- object
    CString ->
    Ptr () ->                               -- user_data
    IO CInt

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

wrap_VimIMContextExecuteCommandCallback :: 
    GObject a => (a -> VimIMContextExecuteCommandCallback) ->
    C_VimIMContextExecuteCommandCallback
wrap_VimIMContextExecuteCommandCallback :: forall a.
GObject a =>
(a -> VimIMContextExecuteCommandCallback)
-> C_VimIMContextExecuteCommandCallback
wrap_VimIMContextExecuteCommandCallback a -> VimIMContextExecuteCommandCallback
gi'cb Ptr VimIMContext
gi'selfPtr CString
command Ptr ()
_ = do
    Text
command' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
command
    Bool
result <- Ptr VimIMContext -> (VimIMContext -> IO Bool) -> IO Bool
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VimIMContext
gi'selfPtr ((VimIMContext -> IO Bool) -> IO Bool)
-> (VimIMContext -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \VimIMContext
gi'self -> a -> VimIMContextExecuteCommandCallback
gi'cb (VimIMContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VimIMContext
gi'self)  Text
command'
    let result' :: CInt
result' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
P.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
P.fromEnum) Bool
result
    CInt -> IO CInt
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CInt
result'


-- | Connect a signal handler for the [executeCommand](#signal:executeCommand) 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' vimIMContext #executeCommand callback
-- @
-- 
-- 
onVimIMContextExecuteCommand :: (IsVimIMContext a, MonadIO m) => a -> ((?self :: a) => VimIMContextExecuteCommandCallback) -> m SignalHandlerId
onVimIMContextExecuteCommand :: forall a (m :: * -> *).
(IsVimIMContext a, MonadIO m) =>
a
-> ((?self::a) => VimIMContextExecuteCommandCallback)
-> m SignalHandlerId
onVimIMContextExecuteCommand a
obj (?self::a) => VimIMContextExecuteCommandCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> VimIMContextExecuteCommandCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VimIMContextExecuteCommandCallback
VimIMContextExecuteCommandCallback
cb
    let wrapped' :: C_VimIMContextExecuteCommandCallback
wrapped' = (a -> VimIMContextExecuteCommandCallback)
-> C_VimIMContextExecuteCommandCallback
forall a.
GObject a =>
(a -> VimIMContextExecuteCommandCallback)
-> C_VimIMContextExecuteCommandCallback
wrap_VimIMContextExecuteCommandCallback a -> VimIMContextExecuteCommandCallback
wrapped
    FunPtr C_VimIMContextExecuteCommandCallback
wrapped'' <- C_VimIMContextExecuteCommandCallback
-> IO (FunPtr C_VimIMContextExecuteCommandCallback)
mk_VimIMContextExecuteCommandCallback C_VimIMContextExecuteCommandCallback
wrapped'
    a
-> Text
-> FunPtr C_VimIMContextExecuteCommandCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"execute-command" FunPtr C_VimIMContextExecuteCommandCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [executeCommand](#signal:executeCommand) 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' vimIMContext #executeCommand 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.
-- 
afterVimIMContextExecuteCommand :: (IsVimIMContext a, MonadIO m) => a -> ((?self :: a) => VimIMContextExecuteCommandCallback) -> m SignalHandlerId
afterVimIMContextExecuteCommand :: forall a (m :: * -> *).
(IsVimIMContext a, MonadIO m) =>
a
-> ((?self::a) => VimIMContextExecuteCommandCallback)
-> m SignalHandlerId
afterVimIMContextExecuteCommand a
obj (?self::a) => VimIMContextExecuteCommandCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> VimIMContextExecuteCommandCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VimIMContextExecuteCommandCallback
VimIMContextExecuteCommandCallback
cb
    let wrapped' :: C_VimIMContextExecuteCommandCallback
wrapped' = (a -> VimIMContextExecuteCommandCallback)
-> C_VimIMContextExecuteCommandCallback
forall a.
GObject a =>
(a -> VimIMContextExecuteCommandCallback)
-> C_VimIMContextExecuteCommandCallback
wrap_VimIMContextExecuteCommandCallback a -> VimIMContextExecuteCommandCallback
wrapped
    FunPtr C_VimIMContextExecuteCommandCallback
wrapped'' <- C_VimIMContextExecuteCommandCallback
-> IO (FunPtr C_VimIMContextExecuteCommandCallback)
mk_VimIMContextExecuteCommandCallback C_VimIMContextExecuteCommandCallback
wrapped'
    a
-> Text
-> FunPtr C_VimIMContextExecuteCommandCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"execute-command" FunPtr C_VimIMContextExecuteCommandCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VimIMContextExecuteCommandSignalInfo
instance SignalInfo VimIMContextExecuteCommandSignalInfo where
    type HaskellCallbackType VimIMContextExecuteCommandSignalInfo = VimIMContextExecuteCommandCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VimIMContextExecuteCommandCallback cb
        cb'' <- mk_VimIMContextExecuteCommandCallback cb'
        connectSignalFunPtr obj "execute-command" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext::execute-command"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#g:signal:executeCommand"})

#endif

-- signal VimIMContext::format-text
-- | Requests that the application format the text between
-- /@begin@/ and /@end@/.
-- 
-- /Since: 5.4/
type VimIMContextFormatTextCallback =
    Gtk.TextIter.TextIter
    -- ^ /@begin@/: the start location
    -> Gtk.TextIter.TextIter
    -- ^ /@end@/: the end location
    -> IO ()

type C_VimIMContextFormatTextCallback =
    Ptr VimIMContext ->                     -- object
    Ptr Gtk.TextIter.TextIter ->
    Ptr Gtk.TextIter.TextIter ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VimIMContextFormatTextCallback :: 
    GObject a => (a -> VimIMContextFormatTextCallback) ->
    C_VimIMContextFormatTextCallback
wrap_VimIMContextFormatTextCallback :: forall a.
GObject a =>
(a -> VimIMContextFormatTextCallback)
-> C_VimIMContextFormatTextCallback
wrap_VimIMContextFormatTextCallback a -> VimIMContextFormatTextCallback
gi'cb Ptr VimIMContext
gi'selfPtr Ptr TextIter
begin Ptr TextIter
end Ptr ()
_ = do
    Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr TextIter
begin ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
begin' -> do
        Ptr TextIter -> (TextIter -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient  Ptr TextIter
end ((TextIter -> IO ()) -> IO ()) -> (TextIter -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \TextIter
end' -> do
            Ptr VimIMContext -> (VimIMContext -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VimIMContext
gi'selfPtr ((VimIMContext -> IO ()) -> IO ())
-> (VimIMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VimIMContext
gi'self -> a -> VimIMContextFormatTextCallback
gi'cb (VimIMContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VimIMContext
gi'self)  TextIter
begin' TextIter
end'


-- | Connect a signal handler for the [formatText](#signal:formatText) 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' vimIMContext #formatText callback
-- @
-- 
-- 
onVimIMContextFormatText :: (IsVimIMContext a, MonadIO m) => a -> ((?self :: a) => VimIMContextFormatTextCallback) -> m SignalHandlerId
onVimIMContextFormatText :: forall a (m :: * -> *).
(IsVimIMContext a, MonadIO m) =>
a
-> ((?self::a) => VimIMContextFormatTextCallback)
-> m SignalHandlerId
onVimIMContextFormatText a
obj (?self::a) => VimIMContextFormatTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> VimIMContextFormatTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VimIMContextFormatTextCallback
VimIMContextFormatTextCallback
cb
    let wrapped' :: C_VimIMContextFormatTextCallback
wrapped' = (a -> VimIMContextFormatTextCallback)
-> C_VimIMContextFormatTextCallback
forall a.
GObject a =>
(a -> VimIMContextFormatTextCallback)
-> C_VimIMContextFormatTextCallback
wrap_VimIMContextFormatTextCallback a -> VimIMContextFormatTextCallback
wrapped
    FunPtr C_VimIMContextFormatTextCallback
wrapped'' <- C_VimIMContextFormatTextCallback
-> IO (FunPtr C_VimIMContextFormatTextCallback)
mk_VimIMContextFormatTextCallback C_VimIMContextFormatTextCallback
wrapped'
    a
-> Text
-> FunPtr C_VimIMContextFormatTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"format-text" FunPtr C_VimIMContextFormatTextCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [formatText](#signal:formatText) 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' vimIMContext #formatText 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.
-- 
afterVimIMContextFormatText :: (IsVimIMContext a, MonadIO m) => a -> ((?self :: a) => VimIMContextFormatTextCallback) -> m SignalHandlerId
afterVimIMContextFormatText :: forall a (m :: * -> *).
(IsVimIMContext a, MonadIO m) =>
a
-> ((?self::a) => VimIMContextFormatTextCallback)
-> m SignalHandlerId
afterVimIMContextFormatText a
obj (?self::a) => VimIMContextFormatTextCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> VimIMContextFormatTextCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VimIMContextFormatTextCallback
VimIMContextFormatTextCallback
cb
    let wrapped' :: C_VimIMContextFormatTextCallback
wrapped' = (a -> VimIMContextFormatTextCallback)
-> C_VimIMContextFormatTextCallback
forall a.
GObject a =>
(a -> VimIMContextFormatTextCallback)
-> C_VimIMContextFormatTextCallback
wrap_VimIMContextFormatTextCallback a -> VimIMContextFormatTextCallback
wrapped
    FunPtr C_VimIMContextFormatTextCallback
wrapped'' <- C_VimIMContextFormatTextCallback
-> IO (FunPtr C_VimIMContextFormatTextCallback)
mk_VimIMContextFormatTextCallback C_VimIMContextFormatTextCallback
wrapped'
    a
-> Text
-> FunPtr C_VimIMContextFormatTextCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"format-text" FunPtr C_VimIMContextFormatTextCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VimIMContextFormatTextSignalInfo
instance SignalInfo VimIMContextFormatTextSignalInfo where
    type HaskellCallbackType VimIMContextFormatTextSignalInfo = VimIMContextFormatTextCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VimIMContextFormatTextCallback cb
        cb'' <- mk_VimIMContextFormatTextCallback cb'
        connectSignalFunPtr obj "format-text" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext::format-text"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#g:signal:formatText"})

#endif

-- signal VimIMContext::write
-- | Requests the application save the file.
-- 
-- If a filename was provided, it will be available to the signal handler as /@path@/.
-- This may be executed in relation to the user running the @:write@ or @:w@ commands.
-- 
-- /Since: 5.4/
type VimIMContextWriteCallback =
    GtkSource.View.View
    -- ^ /@view@/: the t'GI.GtkSource.Objects.View.View'
    -> Maybe T.Text
    -- ^ /@path@/: the path if provided, otherwise 'P.Nothing'
    -> IO ()

type C_VimIMContextWriteCallback =
    Ptr VimIMContext ->                     -- object
    Ptr GtkSource.View.View ->
    CString ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_VimIMContextWriteCallback :: 
    GObject a => (a -> VimIMContextWriteCallback) ->
    C_VimIMContextWriteCallback
wrap_VimIMContextWriteCallback :: forall a.
GObject a =>
(a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
wrap_VimIMContextWriteCallback a -> VimIMContextEditCallback
gi'cb Ptr VimIMContext
gi'selfPtr Ptr View
view CString
path Ptr ()
_ = do
    View
view' <- ((ManagedPtr View -> View) -> Ptr View -> IO View
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr View -> View
GtkSource.View.View) Ptr View
view
    Maybe Text
maybePath <-
        if CString
path CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
== CString
forall a. Ptr a
nullPtr
        then Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
forall a. Maybe a
Nothing
        else do
            Text
path' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
path
            Maybe Text -> IO (Maybe Text)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Text -> IO (Maybe Text)) -> Maybe Text -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
path'
    Ptr VimIMContext -> (VimIMContext -> IO ()) -> IO ()
forall o b.
(HasCallStack, GObject o) =>
Ptr o -> (o -> IO b) -> IO b
B.ManagedPtr.withNewObject Ptr VimIMContext
gi'selfPtr ((VimIMContext -> IO ()) -> IO ())
-> (VimIMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \VimIMContext
gi'self -> a -> VimIMContextEditCallback
gi'cb (VimIMContext -> a
forall a b. Coercible a b => a -> b
Coerce.coerce VimIMContext
gi'self)  View
view' Maybe Text
maybePath


-- | Connect a signal handler for the [write](#signal:write) 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' vimIMContext #write callback
-- @
-- 
-- 
onVimIMContextWrite :: (IsVimIMContext a, MonadIO m) => a -> ((?self :: a) => VimIMContextWriteCallback) -> m SignalHandlerId
onVimIMContextWrite :: forall a (m :: * -> *).
(IsVimIMContext a, MonadIO m) =>
a -> ((?self::a) => VimIMContextEditCallback) -> m SignalHandlerId
onVimIMContextWrite a
obj (?self::a) => VimIMContextEditCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> VimIMContextEditCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VimIMContextEditCallback
VimIMContextEditCallback
cb
    let wrapped' :: C_VimIMContextEditCallback
wrapped' = (a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
forall a.
GObject a =>
(a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
wrap_VimIMContextWriteCallback a -> VimIMContextEditCallback
wrapped
    FunPtr C_VimIMContextEditCallback
wrapped'' <- C_VimIMContextEditCallback
-> IO (FunPtr C_VimIMContextEditCallback)
mk_VimIMContextWriteCallback C_VimIMContextEditCallback
wrapped'
    a
-> Text
-> FunPtr C_VimIMContextEditCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"write" FunPtr C_VimIMContextEditCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [write](#signal:write) 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' vimIMContext #write 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.
-- 
afterVimIMContextWrite :: (IsVimIMContext a, MonadIO m) => a -> ((?self :: a) => VimIMContextWriteCallback) -> m SignalHandlerId
afterVimIMContextWrite :: forall a (m :: * -> *).
(IsVimIMContext a, MonadIO m) =>
a -> ((?self::a) => VimIMContextEditCallback) -> m SignalHandlerId
afterVimIMContextWrite a
obj (?self::a) => VimIMContextEditCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall a. IO a -> m a
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 -> VimIMContextEditCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => VimIMContextEditCallback
VimIMContextEditCallback
cb
    let wrapped' :: C_VimIMContextEditCallback
wrapped' = (a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
forall a.
GObject a =>
(a -> VimIMContextEditCallback) -> C_VimIMContextEditCallback
wrap_VimIMContextWriteCallback a -> VimIMContextEditCallback
wrapped
    FunPtr C_VimIMContextEditCallback
wrapped'' <- C_VimIMContextEditCallback
-> IO (FunPtr C_VimIMContextEditCallback)
mk_VimIMContextWriteCallback C_VimIMContextEditCallback
wrapped'
    a
-> Text
-> FunPtr C_VimIMContextEditCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"write" FunPtr C_VimIMContextEditCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data VimIMContextWriteSignalInfo
instance SignalInfo VimIMContextWriteSignalInfo where
    type HaskellCallbackType VimIMContextWriteSignalInfo = VimIMContextWriteCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_VimIMContextWriteCallback cb
        cb'' <- mk_VimIMContextWriteCallback cb'
        connectSignalFunPtr obj "write" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext::write"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#g:signal:write"})

#endif

-- VVV Prop "command-bar-text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@command-bar-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vimIMContext #commandBarText
-- @
getVimIMContextCommandBarText :: (MonadIO m, IsVimIMContext o) => o -> m T.Text
getVimIMContextCommandBarText :: forall (m :: * -> *) o.
(MonadIO m, IsVimIMContext o) =>
o -> m Text
getVimIMContextCommandBarText o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getVimIMContextCommandBarText" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"command-bar-text"

#if defined(ENABLE_OVERLOADING)
data VimIMContextCommandBarTextPropertyInfo
instance AttrInfo VimIMContextCommandBarTextPropertyInfo where
    type AttrAllowedOps VimIMContextCommandBarTextPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint VimIMContextCommandBarTextPropertyInfo = IsVimIMContext
    type AttrSetTypeConstraint VimIMContextCommandBarTextPropertyInfo = (~) ()
    type AttrTransferTypeConstraint VimIMContextCommandBarTextPropertyInfo = (~) ()
    type AttrTransferType VimIMContextCommandBarTextPropertyInfo = ()
    type AttrGetType VimIMContextCommandBarTextPropertyInfo = T.Text
    type AttrLabel VimIMContextCommandBarTextPropertyInfo = "command-bar-text"
    type AttrOrigin VimIMContextCommandBarTextPropertyInfo = VimIMContext
    attrGet = getVimIMContextCommandBarText
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext.commandBarText"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#g:attr:commandBarText"
        })
#endif

-- VVV Prop "command-text"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@command-text@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' vimIMContext #commandText
-- @
getVimIMContextCommandText :: (MonadIO m, IsVimIMContext o) => o -> m T.Text
getVimIMContextCommandText :: forall (m :: * -> *) o.
(MonadIO m, IsVimIMContext o) =>
o -> m Text
getVimIMContextCommandText o
obj = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getVimIMContextCommandText" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"command-text"

#if defined(ENABLE_OVERLOADING)
data VimIMContextCommandTextPropertyInfo
instance AttrInfo VimIMContextCommandTextPropertyInfo where
    type AttrAllowedOps VimIMContextCommandTextPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint VimIMContextCommandTextPropertyInfo = IsVimIMContext
    type AttrSetTypeConstraint VimIMContextCommandTextPropertyInfo = (~) ()
    type AttrTransferTypeConstraint VimIMContextCommandTextPropertyInfo = (~) ()
    type AttrTransferType VimIMContextCommandTextPropertyInfo = ()
    type AttrGetType VimIMContextCommandTextPropertyInfo = T.Text
    type AttrLabel VimIMContextCommandTextPropertyInfo = "command-text"
    type AttrOrigin VimIMContextCommandTextPropertyInfo = VimIMContext
    attrGet = getVimIMContextCommandText
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext.commandText"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#g:attr:commandText"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList VimIMContext
type instance O.AttributeList VimIMContext = VimIMContextAttributeList
type VimIMContextAttributeList = ('[ '("commandBarText", VimIMContextCommandBarTextPropertyInfo), '("commandText", VimIMContextCommandTextPropertyInfo), '("inputHints", Gtk.IMContext.IMContextInputHintsPropertyInfo), '("inputPurpose", Gtk.IMContext.IMContextInputPurposePropertyInfo)] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
vimIMContextCommandBarText :: AttrLabelProxy "commandBarText"
vimIMContextCommandBarText = AttrLabelProxy

vimIMContextCommandText :: AttrLabelProxy "commandText"
vimIMContextCommandText = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList VimIMContext = VimIMContextSignalList
type VimIMContextSignalList = ('[ '("commit", Gtk.IMContext.IMContextCommitSignalInfo), '("deleteSurrounding", Gtk.IMContext.IMContextDeleteSurroundingSignalInfo), '("edit", VimIMContextEditSignalInfo), '("executeCommand", VimIMContextExecuteCommandSignalInfo), '("formatText", VimIMContextFormatTextSignalInfo), '("notify", GObject.Object.ObjectNotifySignalInfo), '("preeditChanged", Gtk.IMContext.IMContextPreeditChangedSignalInfo), '("preeditEnd", Gtk.IMContext.IMContextPreeditEndSignalInfo), '("preeditStart", Gtk.IMContext.IMContextPreeditStartSignalInfo), '("retrieveSurrounding", Gtk.IMContext.IMContextRetrieveSurroundingSignalInfo), '("write", VimIMContextWriteSignalInfo)] :: [(Symbol, DK.Type)])

#endif

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

foreign import ccall "gtk_source_vim_im_context_new" gtk_source_vim_im_context_new :: 
    IO (Ptr VimIMContext)

-- | /No description available in the introspection data./
vimIMContextNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m VimIMContext
vimIMContextNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m VimIMContext
vimIMContextNew  = IO VimIMContext -> m VimIMContext
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO VimIMContext -> m VimIMContext)
-> IO VimIMContext -> m VimIMContext
forall a b. (a -> b) -> a -> b
$ do
    Ptr VimIMContext
result <- IO (Ptr VimIMContext)
gtk_source_vim_im_context_new
    Text -> Ptr VimIMContext -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vimIMContextNew" Ptr VimIMContext
result
    VimIMContext
result' <- ((ManagedPtr VimIMContext -> VimIMContext)
-> Ptr VimIMContext -> IO VimIMContext
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr VimIMContext -> VimIMContext
VimIMContext) Ptr VimIMContext
result
    VimIMContext -> IO VimIMContext
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return VimIMContext
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method VimIMContext::execute_command
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "VimIMContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceVimIMContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "command"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the command text" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_vim_im_context_execute_command" gtk_source_vim_im_context_execute_command :: 
    Ptr VimIMContext ->                     -- self : TInterface (Name {namespace = "GtkSource", name = "VimIMContext"})
    CString ->                              -- command : TBasicType TUTF8
    IO ()

-- | Executes /@command@/ as if it was typed into the command bar by the
-- user except that this does not emit the
-- [signal/@vimIMContext@/[executeCommand](#g:signal:executeCommand)] signal.
-- 
-- /Since: 5.4/
vimIMContextExecuteCommand ::
    (B.CallStack.HasCallStack, MonadIO m, IsVimIMContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.VimIMContext.VimIMContext'
    -> T.Text
    -- ^ /@command@/: the command text
    -> m ()
vimIMContextExecuteCommand :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVimIMContext a) =>
a -> Text -> m ()
vimIMContextExecuteCommand a
self Text
command = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr VimIMContext
self' <- a -> IO (Ptr VimIMContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
command' <- Text -> IO CString
textToCString Text
command
    Ptr VimIMContext -> CString -> IO ()
gtk_source_vim_im_context_execute_command Ptr VimIMContext
self' CString
command'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
command'
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data VimIMContextExecuteCommandMethodInfo
instance (signature ~ (T.Text -> m ()), MonadIO m, IsVimIMContext a) => O.OverloadedMethod VimIMContextExecuteCommandMethodInfo a signature where
    overloadedMethod = vimIMContextExecuteCommand

instance O.OverloadedMethodInfo VimIMContextExecuteCommandMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext.vimIMContextExecuteCommand",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#v:vimIMContextExecuteCommand"
        })


#endif

-- method VimIMContext::get_command_bar_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "VimIMContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceVimIMContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_vim_im_context_get_command_bar_text" gtk_source_vim_im_context_get_command_bar_text :: 
    Ptr VimIMContext ->                     -- self : TInterface (Name {namespace = "GtkSource", name = "VimIMContext"})
    IO CString

-- | Gets the current command-bar text as it is entered by the user.
-- 
-- /Since: 5.4/
vimIMContextGetCommandBarText ::
    (B.CallStack.HasCallStack, MonadIO m, IsVimIMContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.VimIMContext.VimIMContext'
    -> m T.Text
    -- ^ __Returns:__ A string containing the command-bar text
vimIMContextGetCommandBarText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVimIMContext a) =>
a -> m Text
vimIMContextGetCommandBarText a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr VimIMContext
self' <- a -> IO (Ptr VimIMContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr VimIMContext -> IO CString
gtk_source_vim_im_context_get_command_bar_text Ptr VimIMContext
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vimIMContextGetCommandBarText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data VimIMContextGetCommandBarTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVimIMContext a) => O.OverloadedMethod VimIMContextGetCommandBarTextMethodInfo a signature where
    overloadedMethod = vimIMContextGetCommandBarText

instance O.OverloadedMethodInfo VimIMContextGetCommandBarTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext.vimIMContextGetCommandBarText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#v:vimIMContextGetCommandBarText"
        })


#endif

-- method VimIMContext::get_command_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "GtkSource" , name = "VimIMContext" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GtkSourceVimIMContext"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUTF8)
-- throws : False
-- Skip return : False

foreign import ccall "gtk_source_vim_im_context_get_command_text" gtk_source_vim_im_context_get_command_text :: 
    Ptr VimIMContext ->                     -- self : TInterface (Name {namespace = "GtkSource", name = "VimIMContext"})
    IO CString

-- | Gets the current command text as it is entered by the user.
-- 
-- /Since: 5.4/
vimIMContextGetCommandText ::
    (B.CallStack.HasCallStack, MonadIO m, IsVimIMContext a) =>
    a
    -- ^ /@self@/: a t'GI.GtkSource.Objects.VimIMContext.VimIMContext'
    -> m T.Text
    -- ^ __Returns:__ A string containing the command text
vimIMContextGetCommandText :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsVimIMContext a) =>
a -> m Text
vimIMContextGetCommandText a
self = IO Text -> m Text
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr VimIMContext
self' <- a -> IO (Ptr VimIMContext)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr VimIMContext -> IO CString
gtk_source_vim_im_context_get_command_text Ptr VimIMContext
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"vimIMContextGetCommandText" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data VimIMContextGetCommandTextMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsVimIMContext a) => O.OverloadedMethod VimIMContextGetCommandTextMethodInfo a signature where
    overloadedMethod = vimIMContextGetCommandText

instance O.OverloadedMethodInfo VimIMContextGetCommandTextMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.GtkSource.Objects.VimIMContext.vimIMContextGetCommandText",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gtksource-5.0.1/docs/GI-GtkSource-Objects-VimIMContext.html#v:vimIMContextGetCommandText"
        })


#endif