{-# LINE 2 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget IMContext
--
-- Author : Colin McQuillan
--
-- Created: 30 April 2009
--
-- Copyright (C) 2009 Colin McQuillan
--
-- This library is free software; you can redistribute it and/or
-- modify it under the terms of the GNU Lesser General Public
-- License as published by the Free Software Foundation; either
-- version 2.1 of the License, or (at your option) any later version.
--
-- This library is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
-- Lesser General Public License for more details.
--
-- |
-- Maintainer : gtk2hs-users@lists.sourceforge.net
-- Stability : provisional
-- Portability : portable (depends on GHC)
--
-- Base class for input method contexts
--
module Graphics.UI.Gtk.Abstract.IMContext (

-- * Class Hierarchy
--
-- |
-- @
-- | 'GObject'
-- | +----IMContext
-- | +----'IMContextSimple'
-- | +----'IMMulticontext'
-- @

-- * Types
  IMContext,
  IMContextClass,
  castToIMContext, gTypeIMContext,
  toIMContext,

-- * Methods
  imContextSetClientWindow,
  imContextGetPreeditString,
  imContextFilterKeypress,
  imContextFocusIn,
  imContextFocusOut,
  imContextReset,
  imContextSetCursorLocation,
  imContextSetUsePreedit,
  imContextSetSurrounding,
  imContextGetSurrounding,
  imContextDeleteSurrounding,

-- * Signals
  imContextPreeditStart,
  imContextPreeditEnd,
  imContextPreeditChanged,
  imContextCommit,
  imContextRetrieveSurrounding,
  imContextDeleteSurrounding',
  ) where

import Control.Monad (liftM)
import Control.Monad.Reader.Class (ask)
import Control.Monad.Trans (liftIO)
import Data.Maybe (fromMaybe)

import System.Glib.FFI
import System.Glib.UTFString (readUTFString, withUTFString, genUTFOfs,
                              ofsToUTF, ofsFromUTF, GlibString)
import Graphics.UI.Gtk.Types
{-# LINE 77 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 78 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
import Graphics.UI.Gtk.Gdk.EventM (EventM, EKey)
import Graphics.UI.Gtk.General.Structs (Rectangle)
import Graphics.Rendering.Pango.Enums (PangoAttribute)
import Graphics.Rendering.Pango.Attributes (readAttrList)


{-# LINE 84 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}

--------------------
-- Methods

-- | Set the client window for the input context; this is the 'DrawWindow' in
-- which the input appears. This window is used in order to correctly position
-- status windows, and may also be used for purposes internal to the input
-- method.
--
imContextSetClientWindow :: IMContextClass self => self
 -> Maybe DrawWindow -- ^ @window@ - the client window. 'Nothing' indicates
                     -- that the previous client window no longer exists.
 -> IO ()
imContextSetClientWindow :: forall self.
IMContextClass self =>
self -> Maybe DrawWindow -> IO ()
imContextSetClientWindow self
self Maybe DrawWindow
window =
  (\(IMContext ForeignPtr IMContext
arg1) (DrawWindow ForeignPtr DrawWindow
arg2) -> ForeignPtr IMContext -> (Ptr IMContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO ()) -> IO ())
-> (Ptr IMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->ForeignPtr DrawWindow -> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr DrawWindow
arg2 ((Ptr DrawWindow -> IO ()) -> IO ())
-> (Ptr DrawWindow -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr DrawWindow
argPtr2 ->Ptr IMContext -> Ptr DrawWindow -> IO ()
gtk_im_context_set_client_window Ptr IMContext
argPtr1 Ptr DrawWindow
argPtr2)
{-# LINE 99 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)
    (DrawWindow -> Maybe DrawWindow -> DrawWindow
forall a. a -> Maybe a -> a
fromMaybe (ForeignPtr DrawWindow -> DrawWindow
DrawWindow ForeignPtr DrawWindow
forall a. ForeignPtr a
nullForeignPtr) Maybe DrawWindow
window)

-- | Retrieve the current preedit string for the input context, and a list of
-- attributes to apply to the string. This string should be displayed inserted
-- at the insertion point.
--
imContextGetPreeditString :: (IMContextClass self, GlibString string) => self
 -> IO (string, [[PangoAttribute]], Int)
                    -- ^ @(str, attrs, cursorPos)@ Retrieved string,
                    -- attributes to apply to the string, position of cursor.
imContextGetPreeditString :: forall self string.
(IMContextClass self, GlibString string) =>
self -> IO (string, [[PangoAttribute]], Int)
imContextGetPreeditString self
self =
  (Ptr (Ptr CChar) -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CChar) -> IO (string, [[PangoAttribute]], Int))
 -> IO (string, [[PangoAttribute]], Int))
-> (Ptr (Ptr CChar) -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
strPtr ->
  (Ptr (Ptr ()) -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr ()) -> IO (string, [[PangoAttribute]], Int))
 -> IO (string, [[PangoAttribute]], Int))
-> (Ptr (Ptr ()) -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr ())
attrListPtr ->
  (Ptr CInt -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (string, [[PangoAttribute]], Int))
 -> IO (string, [[PangoAttribute]], Int))
-> (Ptr CInt -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
cursorPosPtr ->
  (\(IMContext ForeignPtr IMContext
arg1) Ptr (Ptr CChar)
arg2 Ptr (Ptr ())
arg3 Ptr CInt
arg4 -> ForeignPtr IMContext -> (Ptr IMContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO ()) -> IO ())
-> (Ptr IMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext
-> Ptr (Ptr CChar) -> Ptr (Ptr ()) -> Ptr CInt -> IO ()
gtk_im_context_get_preedit_string Ptr IMContext
argPtr1 Ptr (Ptr CChar)
arg2 Ptr (Ptr ())
arg3 Ptr CInt
arg4)
{-# LINE 115 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)
    Ptr (Ptr CChar)
strPtr
    Ptr (Ptr ())
attrListPtr
    Ptr CInt
cursorPosPtr
  IO () -> IO (Ptr CChar) -> IO (Ptr CChar)
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
  Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
strPtr IO (Ptr CChar) -> (Ptr CChar -> IO string) -> IO string
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
readUTFString IO string
-> (string -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \string
str ->
  Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
attrListPtr IO (Ptr ())
-> (Ptr () -> IO [[PangoAttribute]]) -> IO [[PangoAttribute]]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= UTFCorrection -> Ptr () -> IO [[PangoAttribute]]
readAttrList (string -> UTFCorrection
forall s. GlibString s => s -> UTFCorrection
genUTFOfs string
str) IO [[PangoAttribute]]
-> ([[PangoAttribute]] -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \[[PangoAttribute]]
attrs ->
  Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
cursorPosPtr IO CInt
-> (CInt -> IO (string, [[PangoAttribute]], Int))
-> IO (string, [[PangoAttribute]], Int)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
cursorPos ->
  (string, [[PangoAttribute]], Int)
-> IO (string, [[PangoAttribute]], Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (string
str, [[PangoAttribute]]
attrs, CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cursorPos)

-- | Allow an input method to internally handle key press and release events.
-- If this function returns @True@, then no further processing should be done
-- for this key event.
--
imContextFilterKeypress :: IMContextClass self => self
 -> EventM EKey Bool -- ^ returns @True@ if the input method handled the key
                     -- event.
imContextFilterKeypress :: forall self. IMContextClass self => self -> EventM EKey Bool
imContextFilterKeypress self
self =
  (CInt -> Bool) -> ReaderT (Ptr EKey) IO CInt -> EventM EKey Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (ReaderT (Ptr EKey) IO CInt -> EventM EKey Bool)
-> ReaderT (Ptr EKey) IO CInt -> EventM EKey Bool
forall a b. (a -> b) -> a -> b
$
  ReaderT (Ptr EKey) IO (Ptr EKey)
forall r (m :: * -> *). MonadReader r m => m r
ask ReaderT (Ptr EKey) IO (Ptr EKey)
-> (Ptr EKey -> ReaderT (Ptr EKey) IO CInt)
-> ReaderT (Ptr EKey) IO CInt
forall a b.
ReaderT (Ptr EKey) IO a
-> (a -> ReaderT (Ptr EKey) IO b) -> ReaderT (Ptr EKey) IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Ptr EKey
eventPtr ->
  IO CInt -> ReaderT (Ptr EKey) IO CInt
forall a. IO a -> ReaderT (Ptr EKey) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CInt -> ReaderT (Ptr EKey) IO CInt)
-> IO CInt -> ReaderT (Ptr EKey) IO CInt
forall a b. (a -> b) -> a -> b
$
  (\(IMContext ForeignPtr IMContext
arg1) Ptr ()
arg2 -> ForeignPtr IMContext -> (Ptr IMContext -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO CInt) -> IO CInt)
-> (Ptr IMContext -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> Ptr () -> IO CInt
gtk_im_context_filter_keypress Ptr IMContext
argPtr1 Ptr ()
arg2)
{-# LINE 137 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)
    (Ptr EKey -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr EKey
eventPtr)

-- | Notify the input method that the widget to which this input context
-- corresponds has gained focus. The input method may, for example, change the
-- displayed feedback to reflect this change.
--
imContextFocusIn :: IMContextClass self => self -> IO ()
imContextFocusIn :: forall self. IMContextClass self => self -> IO ()
imContextFocusIn self
self =
  (\(IMContext ForeignPtr IMContext
arg1) -> ForeignPtr IMContext -> (Ptr IMContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO ()) -> IO ())
-> (Ptr IMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> IO ()
gtk_im_context_focus_in Ptr IMContext
argPtr1)
{-# LINE 147 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)

-- | Notify the input method that the widget to which this input context
-- corresponds has lost focus. The input method may, for example, change the
-- displayed feedback or reset the contexts state to reflect this change.
--
imContextFocusOut :: IMContextClass self => self -> IO ()
imContextFocusOut :: forall self. IMContextClass self => self -> IO ()
imContextFocusOut self
self =
  (\(IMContext ForeignPtr IMContext
arg1) -> ForeignPtr IMContext -> (Ptr IMContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO ()) -> IO ())
-> (Ptr IMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> IO ()
gtk_im_context_focus_out Ptr IMContext
argPtr1)
{-# LINE 156 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)

-- | Notify the input method that a change such as a change in cursor position
-- has been made. This will typically cause the input method to clear the
-- preedit state.
--
imContextReset :: IMContextClass self => self -> IO ()
imContextReset :: forall self. IMContextClass self => self -> IO ()
imContextReset self
self =
  (\(IMContext ForeignPtr IMContext
arg1) -> ForeignPtr IMContext -> (Ptr IMContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO ()) -> IO ())
-> (Ptr IMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> IO ()
gtk_im_context_reset Ptr IMContext
argPtr1)
{-# LINE 165 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)

-- | Notify the input method that a change in cursor position has been made.
-- The location is relative to the client window.
--
imContextSetCursorLocation :: IMContextClass self => self
 -> Rectangle -- ^ @area@ - new location
 -> IO ()
imContextSetCursorLocation :: forall self. IMContextClass self => self -> Rectangle -> IO ()
imContextSetCursorLocation self
self Rectangle
area =
  Rectangle -> (Ptr Rectangle -> IO ()) -> IO ()
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with Rectangle
area ((Ptr Rectangle -> IO ()) -> IO ())
-> (Ptr Rectangle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Rectangle
areaPtr ->
  (\(IMContext ForeignPtr IMContext
arg1) Ptr ()
arg2 -> ForeignPtr IMContext -> (Ptr IMContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO ()) -> IO ())
-> (Ptr IMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> Ptr () -> IO ()
gtk_im_context_set_cursor_location Ptr IMContext
argPtr1 Ptr ()
arg2)
{-# LINE 176 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)
    (Ptr Rectangle -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Rectangle
areaPtr)

-- | Sets whether the IM context should use the preedit string to display
-- feedback. If @usePreedit@ is @False@ (default is @True@), then the IM
-- context may use some other method to display feedback, such as displaying it
-- in a child of the root window.
--
imContextSetUsePreedit :: IMContextClass self => self
 -> Bool -- ^ @usePreedit@ - whether the IM context should use the preedit
         -- string.
 -> IO ()
imContextSetUsePreedit :: forall self. IMContextClass self => self -> Bool -> IO ()
imContextSetUsePreedit self
self Bool
usePreedit =
  (\(IMContext ForeignPtr IMContext
arg1) CInt
arg2 -> ForeignPtr IMContext -> (Ptr IMContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO ()) -> IO ())
-> (Ptr IMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> CInt -> IO ()
gtk_im_context_set_use_preedit Ptr IMContext
argPtr1 CInt
arg2)
{-# LINE 190 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
usePreedit)

-- | Sets surrounding context around the insertion point and preedit string.
-- This function is expected to be called in response to the
-- 'imContextRetrieveSurrounding' signal, and will likely have no effect if
-- called at other times.
--
imContextSetSurrounding :: (IMContextClass self, GlibString string) => self
 -> string -- ^ @text@ - text surrounding the insertion point, as UTF-8. the
           -- preedit string should not be included within @text@.
 -> Int -- ^ @cursorIndex@ - the index of the insertion cursor within
           -- @text@.
 -> IO ()
imContextSetSurrounding :: forall self string.
(IMContextClass self, GlibString string) =>
self -> string -> Int -> IO ()
imContextSetSurrounding self
self string
text Int
cursorIndex =
  string -> (Ptr CChar -> IO ()) -> IO ()
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString string
text ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
textPtr ->
  (\(IMContext ForeignPtr IMContext
arg1) Ptr CChar
arg2 CInt
arg3 CInt
arg4 -> ForeignPtr IMContext -> (Ptr IMContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO ()) -> IO ())
-> (Ptr IMContext -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> Ptr CChar -> CInt -> CInt -> IO ()
gtk_im_context_set_surrounding Ptr IMContext
argPtr1 Ptr CChar
arg2 CInt
arg3 CInt
arg4)
{-# LINE 207 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)
    Ptr CChar
textPtr
    (-CInt
1)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> UTFCorrection -> Int
ofsToUTF Int
cursorIndex (string -> UTFCorrection
forall s. GlibString s => s -> UTFCorrection
genUTFOfs string
text)))

-- | Retrieves context around the insertion point. Input methods typically
-- want context in order to constrain input text based on existing text; this
-- is important for languages such as Thai where only some sequences of
-- characters are allowed.
--
-- This function is implemented by emitting the
-- 'imContextRetrieveSurrounding' signal on the input method; in response to
-- this signal, a widget should provide as much context as is available, up to
-- an entire paragraph, by calling 'imContextSetSurrounding'. Note that there
-- is no obligation for a widget to respond to the 'imContextRetrieveSurrounding'
-- signal, so input methods must be prepared to function without context.
--
imContextGetSurrounding :: (IMContextClass self, GlibString string) => self
 -> IO (Maybe (string, Int)) -- ^ @Maybe (text,cursorIndex)@ Text holding
                             -- context around the insertion point and the
                             -- index of the insertion cursor within @text@.
                             -- 'Nothing' if no surrounding text was
                             -- provided.
imContextGetSurrounding :: forall self string.
(IMContextClass self, GlibString string) =>
self -> IO (Maybe (string, Int))
imContextGetSurrounding self
self =
  (Ptr (Ptr CChar) -> IO (Maybe (string, Int)))
-> IO (Maybe (string, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr CChar) -> IO (Maybe (string, Int)))
 -> IO (Maybe (string, Int)))
-> (Ptr (Ptr CChar) -> IO (Maybe (string, Int)))
-> IO (Maybe (string, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr CChar)
textPtr ->
  (Ptr CInt -> IO (Maybe (string, Int))) -> IO (Maybe (string, Int))
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Maybe (string, Int)))
 -> IO (Maybe (string, Int)))
-> (Ptr CInt -> IO (Maybe (string, Int)))
-> IO (Maybe (string, Int))
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
cursorIndexPtr ->
  (\(IMContext ForeignPtr IMContext
arg1) Ptr (Ptr CChar)
arg2 Ptr CInt
arg3 -> ForeignPtr IMContext -> (Ptr IMContext -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO CInt) -> IO CInt)
-> (Ptr IMContext -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> Ptr (Ptr CChar) -> Ptr CInt -> IO CInt
gtk_im_context_get_surrounding Ptr IMContext
argPtr1 Ptr (Ptr CChar)
arg2 Ptr CInt
arg3)
{-# LINE 234 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)
    Ptr (Ptr CChar)
textPtr
    Ptr CInt
cursorIndexPtr IO CInt
-> (CInt -> IO (Maybe (string, Int))) -> IO (Maybe (string, Int))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
provided ->
  if CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool CInt
provided then
      Ptr (Ptr CChar) -> IO (Ptr CChar)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CChar)
textPtr IO (Ptr CChar) -> (Ptr CChar -> IO string) -> IO string
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
readUTFString IO string
-> (string -> IO (Maybe (string, Int))) -> IO (Maybe (string, Int))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \string
text ->
      Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
cursorIndexPtr IO CInt
-> (CInt -> IO (Maybe (string, Int))) -> IO (Maybe (string, Int))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
cursorIndex ->
      Maybe (string, Int) -> IO (Maybe (string, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((string, Int) -> Maybe (string, Int)
forall a. a -> Maybe a
Just (string
text, Int -> UTFCorrection -> Int
ofsFromUTF (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
cursorIndex)
                                     (string -> UTFCorrection
forall s. GlibString s => s -> UTFCorrection
genUTFOfs string
text)))
  else
      Maybe (string, Int) -> IO (Maybe (string, Int))
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (string, Int)
forall a. Maybe a
Nothing

-- | Asks the widget that the input context is attached to to delete
-- characters around the cursor position by emitting the
-- 'imContextDeleteSurrounding' signal.
--
-- In order to use this function, you should first call
-- 'imContextGetSurrounding' to get the current context, and call this function
-- immediately afterwards to make sure that you know what you are deleting. You
-- should also account for the fact that even if the signal was handled, the
-- input context might not have deleted all the characters that were requested
-- to be deleted.
--
-- This function is used by an input method that wants to make substitutions
-- in the existing text in response to new input. It is not useful for
-- applications.
--
imContextDeleteSurrounding :: IMContextClass self => self
 -> Int -- ^ @offset@ - offset from cursor position in chars; a negative
            -- value means start before the cursor.
 -> Int -- ^ @nChars@ - number of characters to delete.
 -> IO Bool -- ^ returns @True@ if the signal was handled.
imContextDeleteSurrounding :: forall self. IMContextClass self => self -> Int -> Int -> IO Bool
imContextDeleteSurrounding self
self Int
offset Int
nChars =
  (CInt -> Bool) -> IO CInt -> IO Bool
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Bool
forall a. (Eq a, Num a) => a -> Bool
toBool (IO CInt -> IO Bool) -> IO CInt -> IO Bool
forall a b. (a -> b) -> a -> b
$
  (\(IMContext ForeignPtr IMContext
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr IMContext -> (Ptr IMContext -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr IMContext
arg1 ((Ptr IMContext -> IO CInt) -> IO CInt)
-> (Ptr IMContext -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr IMContext
argPtr1 ->Ptr IMContext -> CInt -> CInt -> IO CInt
gtk_im_context_delete_surrounding Ptr IMContext
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 268 "./Graphics/UI/Gtk/Abstract/IMContext.chs" #-}
    (toIMContext self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
offset)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nChars)

--------------------
-- Signals

-- | This signal is emitted when a new preediting sequence starts.
--
imContextPreeditStart :: IMContextClass self => Signal self (IO ())
imContextPreeditStart :: forall self. IMContextClass self => Signal self (IO ())
imContextPreeditStart = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"preedit-start")

-- | This signal is emitted when a preediting sequence has been completed or
-- canceled.
--
imContextPreeditEnd :: IMContextClass self => Signal self (IO ())
imContextPreeditEnd :: forall self. IMContextClass self => Signal self (IO ())
imContextPreeditEnd = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"preedit-end")

-- | This signal is emitted whenever the preedit sequence currently being
-- entered has changed. It is also emitted at the end of a preedit sequence,
-- in which case 'imContextGetPreeditString' returns the empty string.
--
imContextPreeditChanged :: IMContextClass self => Signal self (IO ())
imContextPreeditChanged :: forall self. IMContextClass self => Signal self (IO ())
imContextPreeditChanged = (Bool -> self -> IO () -> IO (ConnectId self))
-> Signal self (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO () -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"preedit-changed")

-- | This signal is 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. Parameters:
--
-- @str@ - the completed character(s) entered by the user
imContextCommit :: (IMContextClass self, GlibString string) => Signal self (string -> IO ())
imContextCommit :: forall self string.
(IMContextClass self, GlibString string) =>
Signal self (string -> IO ())
imContextCommit = (Bool -> self -> (string -> IO ()) -> IO (ConnectId self))
-> Signal self (string -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName
-> Bool -> self -> (string -> IO ()) -> IO (ConnectId self)
forall a' obj.
(GlibString a', GObjectClass obj) =>
SignalName -> Bool -> obj -> (a' -> IO ()) -> IO (ConnectId obj)
connect_GLIBSTRING__NONE SignalName
"commit")

-- | This signal is emitted when the input method requires the context
-- surrounding the cursor. The callback should set the input method
-- surrounding context by calling 'imContextSetSurrounding'.
--
-- Returns True if the signal was handled.
imContextRetrieveSurrounding :: IMContextClass self => Signal self (IO Bool)
imContextRetrieveSurrounding :: forall self. IMContextClass self => Signal self (IO Bool)
imContextRetrieveSurrounding = (Bool -> self -> IO Bool -> IO (ConnectId self))
-> Signal self (IO Bool)
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> self -> IO Bool -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO Bool -> IO (ConnectId obj)
connect_NONE__BOOL SignalName
"retrieve-surrounding")

-- | This signal is emitted when the input method needs to delete all or part
-- of the context surrounding the cursor. Parameters:
--
-- @offset@ - the character offset from the cursor position of the text to be
-- deleted. A negative value indicates a position before the cursor.
--
-- @n_chars@ - the number of characters to be deleted.
--
-- Returns True if the signal was handled.
imContextDeleteSurrounding' :: IMContextClass self => Signal self (Int -> Int -> IO Bool)
imContextDeleteSurrounding' :: forall self.
IMContextClass self =>
Signal self (Int -> Int -> IO Bool)
imContextDeleteSurrounding' = (Bool -> self -> (Int -> Int -> IO Bool) -> IO (ConnectId self))
-> Signal self (Int -> Int -> IO Bool)
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName
-> Bool -> self -> (Int -> Int -> IO Bool) -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName
-> Bool -> obj -> (Int -> Int -> IO Bool) -> IO (ConnectId obj)
connect_INT_INT__BOOL SignalName
"delete-surrounding")

foreign import ccall safe "gtk_im_context_set_client_window"
  gtk_im_context_set_client_window :: ((Ptr IMContext) -> ((Ptr DrawWindow) -> (IO ())))

foreign import ccall safe "gtk_im_context_get_preedit_string"
  gtk_im_context_get_preedit_string :: ((Ptr IMContext) -> ((Ptr (Ptr CChar)) -> ((Ptr (Ptr ())) -> ((Ptr CInt) -> (IO ())))))

foreign import ccall safe "gtk_im_context_filter_keypress"
  gtk_im_context_filter_keypress :: ((Ptr IMContext) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "gtk_im_context_focus_in"
  gtk_im_context_focus_in :: ((Ptr IMContext) -> (IO ()))

foreign import ccall safe "gtk_im_context_focus_out"
  gtk_im_context_focus_out :: ((Ptr IMContext) -> (IO ()))

foreign import ccall safe "gtk_im_context_reset"
  gtk_im_context_reset :: ((Ptr IMContext) -> (IO ()))

foreign import ccall safe "gtk_im_context_set_cursor_location"
  gtk_im_context_set_cursor_location :: ((Ptr IMContext) -> ((Ptr ()) -> (IO ())))

foreign import ccall safe "gtk_im_context_set_use_preedit"
  gtk_im_context_set_use_preedit :: ((Ptr IMContext) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_im_context_set_surrounding"
  gtk_im_context_set_surrounding :: ((Ptr IMContext) -> ((Ptr CChar) -> (CInt -> (CInt -> (IO ())))))

foreign import ccall safe "gtk_im_context_get_surrounding"
  gtk_im_context_get_surrounding :: ((Ptr IMContext) -> ((Ptr (Ptr CChar)) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "gtk_im_context_delete_surrounding"
  gtk_im_context_delete_surrounding :: ((Ptr IMContext) -> (CInt -> (CInt -> (IO CInt))))