{-# LINE 2 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Interface Editable
--
-- Author : Axel Simon, Duncan Coutts
--
-- Created: 30 July 2004
--
-- Copyright (C) 1999-2005 Axel Simon, Duncan Coutts
--
-- 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)
--
-- Interface for text-editing widgets
--
module Graphics.UI.Gtk.Entry.Editable (
-- * Detail
--
-- | The 'Editable' interface is an interface which should be implemented by
-- text editing widgets, such as 'Entry'.
-- It contains functions for generically manipulating an editable
-- widget, a large number of action signals used for key bindings, and several
-- signals that an application can connect to to modify the behavior of a
-- widget.
--

-- * Class Hierarchy
-- |
-- @
-- | GInterface
-- | +----Editable
-- @

-- * Types
  Editable,
  EditableClass,
  castToEditable, gTypeEditable,
  toEditable,

-- * Methods
  editableSelectRegion,
  editableGetSelectionBounds,
  editableInsertText,
  editableDeleteText,
  editableGetChars,
  editableCutClipboard,
  editableCopyClipboard,
  editablePasteClipboard,
  editableDeleteSelection,
  editableSetEditable,
  editableGetEditable,
  editableSetPosition,
  editableGetPosition,

-- * Attributes
  editablePosition,
  editableEditable,

-- * Signals
  editableChanged,
  deleteText,
  insertText,
  stopDeleteText,
  stopInsertText,

-- * Deprecated
{-# LINE 87 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
  ) where

import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import Graphics.UI.Gtk.Types
{-# LINE 95 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 96 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}


{-# LINE 98 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}

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

-- | Selects a region of text. The characters that are selected are those
-- characters at positions from @startPos@ up to, but not including @endPos@.
-- If @endPos@ is negative, then the the characters selected will be those
-- characters from @startPos@ to the end of the text.
--
-- Calling this function with @start@=1 and @end@=4 it will mark \"ask\" in
-- the string \"Haskell\".
--
editableSelectRegion :: EditableClass self => self
 -> Int -- ^ @start@ - the starting position.
 -> Int -- ^ @end@ - the end position.
 -> IO ()
editableSelectRegion :: forall self. EditableClass self => self -> Int -> Int -> IO ()
editableSelectRegion self
self Int
start Int
end =
  (\(Editable ForeignPtr Editable
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> CInt -> CInt -> IO ()
gtk_editable_select_region Ptr Editable
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 116 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
start)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
end)

-- | Gets the current selection bounds, if there is a selection.
--
editableGetSelectionBounds :: EditableClass self => self
 -> IO (Int,Int) -- ^ @(start, end)@ - the starting and end positions. This
                 -- pair is not ordered. The @end@ index represents the
                 -- position of the cursor. The @start@ index is the other end
                 -- of the selection. If both numbers are equal there is in
                 -- fact no selection.
editableGetSelectionBounds :: forall self. EditableClass self => self -> IO (Int, Int)
editableGetSelectionBounds self
self =
  (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
startPtr ->
  (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CInt -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
endPtr -> do
  (\(Editable ForeignPtr Editable
arg1) Ptr CInt
arg2 Ptr CInt
arg3 -> ForeignPtr Editable -> (Ptr Editable -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO CInt) -> IO CInt)
-> (Ptr Editable -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> Ptr CInt -> Ptr CInt -> IO CInt
gtk_editable_get_selection_bounds Ptr Editable
argPtr1 Ptr CInt
arg2 Ptr CInt
arg3)
{-# LINE 132 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)
    Ptr CInt
startPtr
    Ptr CInt
endPtr
  Int
start <- (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
startPtr
  Int
end <- (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
endPtr
  (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
start,Int
end)

-- | Inserts text at a given position.
--
editableInsertText :: (EditableClass self, GlibString string) => self
 -> string -- ^ @newText@ - the text to insert.
 -> Int -- ^ @position@ - the position at which to insert the text.
 -> IO Int -- ^ returns the position after the newly inserted text.
editableInsertText :: forall self string.
(EditableClass self, GlibString string) =>
self -> string -> Int -> IO Int
editableInsertText self
self string
newText Int
position =
  CInt -> (Ptr CInt -> IO Int) -> IO Int
forall a b. Storable a => a -> (Ptr a -> IO b) -> IO b
with (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position) ((Ptr CInt -> IO Int) -> IO Int) -> (Ptr CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \Ptr CInt
positionPtr ->
  string -> (CStringLen -> IO Int) -> IO Int
forall a. string -> (CStringLen -> IO a) -> IO a
forall s a. GlibString s => s -> (CStringLen -> IO a) -> IO a
withUTFStringLen string
newText ((CStringLen -> IO Int) -> IO Int)
-> (CStringLen -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
newTextPtr, Int
newTextLength) -> do
  (\(Editable ForeignPtr Editable
arg1) Ptr CChar
arg2 CInt
arg3 Ptr CInt
arg4 -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> Ptr CChar -> CInt -> Ptr CInt -> IO ()
gtk_editable_insert_text Ptr Editable
argPtr1 Ptr CChar
arg2 CInt
arg3 Ptr CInt
arg4)
{-# LINE 149 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)
    Ptr CChar
newTextPtr
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
newTextLength)
    Ptr CInt
positionPtr
  CInt
position <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
positionPtr
  Int -> IO Int
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
position)

-- | Deletes a sequence of characters. The characters that are deleted are
-- those characters at positions from @startPos@ up to, but not including
-- @endPos@. If @endPos@ is negative, then the the characters deleted will be
-- those characters from @startPos@ to the end of the text.
--
editableDeleteText :: EditableClass self => self
 -> Int -- ^ @startPos@ - the starting position.
 -> Int -- ^ @endPos@ - the end position.
 -> IO ()
editableDeleteText :: forall self. EditableClass self => self -> Int -> Int -> IO ()
editableDeleteText self
self Int
startPos Int
endPos =
  (\(Editable ForeignPtr Editable
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> CInt -> CInt -> IO ()
gtk_editable_delete_text Ptr Editable
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 167 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startPos)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endPos)

-- | Retrieves a sequence of characters. The characters that are retrieved are
-- those characters at positions from @startPos@ up to, but not including
-- @endPos@. If @endPos@ is negative, then the the characters retrieved will be
-- those characters from @startPos@ to the end of the text.
--
editableGetChars :: (EditableClass self, GlibString string) => self
 -> Int -- ^ @startPos@ - the starting position.
 -> Int -- ^ @endPos@ - the end position.
 -> IO string -- ^ returns the characters in the indicated region.
editableGetChars :: forall self string.
(EditableClass self, GlibString string) =>
self -> Int -> Int -> IO string
editableGetChars self
self Int
startPos Int
endPos =
  (\(Editable ForeignPtr Editable
arg1) CInt
arg2 CInt
arg3 -> ForeignPtr Editable
-> (Ptr Editable -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr Editable -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> CInt -> CInt -> IO (Ptr CChar)
gtk_editable_get_chars Ptr Editable
argPtr1 CInt
arg2 CInt
arg3)
{-# LINE 182 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
startPos)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
endPos)
  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

-- | Causes the characters in the current selection to be copied to the
-- clipboard and then deleted from the widget.
--
editableCutClipboard :: EditableClass self => self -> IO ()
editableCutClipboard :: forall self. EditableClass self => self -> IO ()
editableCutClipboard self
self =
  (\(Editable ForeignPtr Editable
arg1) -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> IO ()
gtk_editable_cut_clipboard Ptr Editable
argPtr1)
{-# LINE 193 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)

-- | Causes the characters in the current selection to be copied to the
-- clipboard.
--
editableCopyClipboard :: EditableClass self => self -> IO ()
editableCopyClipboard :: forall self. EditableClass self => self -> IO ()
editableCopyClipboard self
self =
  (\(Editable ForeignPtr Editable
arg1) -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> IO ()
gtk_editable_copy_clipboard Ptr Editable
argPtr1)
{-# LINE 201 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)

-- | Causes the contents of the clipboard to be pasted into the given widget
-- at the current cursor position.
--
editablePasteClipboard :: EditableClass self => self -> IO ()
editablePasteClipboard :: forall self. EditableClass self => self -> IO ()
editablePasteClipboard self
self =
  (\(Editable ForeignPtr Editable
arg1) -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> IO ()
gtk_editable_paste_clipboard Ptr Editable
argPtr1)
{-# LINE 209 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)

-- | Deletes the current contents of the widgets selection and disclaims the
-- selection.
--
editableDeleteSelection :: EditableClass self => self -> IO ()
editableDeleteSelection :: forall self. EditableClass self => self -> IO ()
editableDeleteSelection self
self =
  (\(Editable ForeignPtr Editable
arg1) -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> IO ()
gtk_editable_delete_selection Ptr Editable
argPtr1)
{-# LINE 217 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)

-- | Sets the cursor position.
--
editableSetPosition :: EditableClass self => self
 -> Int -- ^ @position@ - the position of the cursor. The cursor is
          -- displayed before the character with the given (base 0) index in
          -- the widget. The value must be less than or equal to the number of
          -- characters in the widget. A value of -1 indicates that the
          -- position should be set after the last character in the entry.
 -> IO ()
editableSetPosition :: forall self. EditableClass self => self -> Int -> IO ()
editableSetPosition self
self Int
position =
  (\(Editable ForeignPtr Editable
arg1) CInt
arg2 -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> CInt -> IO ()
gtk_editable_set_position Ptr Editable
argPtr1 CInt
arg2)
{-# LINE 230 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)

-- | Retrieves the current cursor position.
--
editableGetPosition :: EditableClass self => self
 -> IO Int -- ^ returns the position of the cursor. The cursor is displayed
           -- before the character with the given (base 0) index in the widget.
           -- The value will be less than or equal to the number of characters
           -- in the widget. Note that this position is in characters, not in
           -- bytes.
editableGetPosition :: forall self. EditableClass self => self -> IO Int
editableGetPosition self
self =
  (CInt -> Int) -> IO CInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(Editable ForeignPtr Editable
arg1) -> ForeignPtr Editable -> (Ptr Editable -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO CInt) -> IO CInt)
-> (Ptr Editable -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> IO CInt
gtk_editable_get_position Ptr Editable
argPtr1)
{-# LINE 244 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)

-- | Determines if the user can edit the text in the editable widget or not.
--
editableSetEditable :: EditableClass self => self
 -> Bool -- ^ @isEditable@ - @True@ if the user is allowed to edit the text
          -- in the widget.
 -> IO ()
editableSetEditable :: forall self. EditableClass self => self -> Bool -> IO ()
editableSetEditable self
self Bool
isEditable =
  (\(Editable ForeignPtr Editable
arg1) CInt
arg2 -> ForeignPtr Editable -> (Ptr Editable -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO ()) -> IO ())
-> (Ptr Editable -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> CInt -> IO ()
gtk_editable_set_editable Ptr Editable
argPtr1 CInt
arg2)
{-# LINE 254 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
isEditable)

-- | Retrieves whether the text is editable. See 'editableSetEditable'.
--
editableGetEditable :: EditableClass self => self -> IO Bool
editableGetEditable :: forall self. EditableClass self => self -> IO Bool
editableGetEditable self
self =
  (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
$
  (\(Editable ForeignPtr Editable
arg1) -> ForeignPtr Editable -> (Ptr Editable -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Editable
arg1 ((Ptr Editable -> IO CInt) -> IO CInt)
-> (Ptr Editable -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Editable
argPtr1 ->Ptr Editable -> IO CInt
gtk_editable_get_editable Ptr Editable
argPtr1)
{-# LINE 263 "./Graphics/UI/Gtk/Entry/Editable.chs" #-}
    (toEditable self)

--------------------
-- Attributes

-- | \'position\' property. See 'editableGetPosition' and
-- 'editableSetPosition'
--
editablePosition :: EditableClass self => Attr self Int
editablePosition :: forall self. EditableClass self => Attr self Int
editablePosition = (self -> IO Int)
-> (self -> Int -> IO ()) -> ReadWriteAttr self Int Int
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Int
forall self. EditableClass self => self -> IO Int
editableGetPosition
  self -> Int -> IO ()
forall self. EditableClass self => self -> Int -> IO ()
editableSetPosition

-- | \'editable\' property. See 'editableGetEditable' and
-- 'editableSetEditable'
--
editableEditable :: EditableClass self => Attr self Bool
editableEditable :: forall self. EditableClass self => Attr self Bool
editableEditable = (self -> IO Bool)
-> (self -> Bool -> IO ()) -> ReadWriteAttr self Bool Bool
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Bool
forall self. EditableClass self => self -> IO Bool
editableGetEditable
  self -> Bool -> IO ()
forall self. EditableClass self => self -> Bool -> IO ()
editableSetEditable

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

-- | The 'editableChanged' signal is emitted at the end of a single
-- user-visible operation on the contents of the 'Editable'.
--
-- * For inctance, a paste operation that replaces the contents of the
-- selection will cause only one signal emission (even though it is
-- implemented by first deleting the selection, then inserting the new
-- content, and may cause multiple 'inserText' signals to be
-- emitted).
--
editableChanged :: EditableClass ec => Signal ec (IO ())
editableChanged :: forall ec. EditableClass ec => Signal ec (IO ())
editableChanged = (Bool -> ec -> IO () -> IO (ConnectId ec)) -> Signal ec (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName -> Bool -> ec -> IO () -> IO (ConnectId ec)
forall obj.
GObjectClass obj =>
SignalName -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE SignalName
"changed")

-- | Emitted when a piece of text is deleted from the 'Editable' widget.
--
-- * See 'insertText' for information on how to use this signal.
--
deleteText :: EditableClass self
             => Signal self (Int -> Int -> IO ()) -- ^ @(\startPos endPos -> ...)@
deleteText :: forall self.
EditableClass self =>
Signal self (Int -> Int -> IO ())
deleteText = (Bool -> self -> (Int -> Int -> IO ()) -> IO (ConnectId self))
-> Signal self (Int -> Int -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (SignalName
-> Bool -> self -> (Int -> Int -> IO ()) -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
SignalName
-> Bool -> obj -> (Int -> Int -> IO ()) -> IO (ConnectId obj)
connect_INT_INT__NONE SignalName
"delete-text")

-- | Stop the current signal that deletes text.
stopDeleteText :: EditableClass self => ConnectId self -> IO ()
stopDeleteText :: forall self. EditableClass self => ConnectId self -> IO ()
stopDeleteText (ConnectId CULong
_ self
obj) =
  self -> SignalName -> IO ()
forall obj. GObjectClass obj => obj -> SignalName -> IO ()
signalStopEmission self
obj SignalName
"delete-text"

-- | Emitted when a piece of text is inserted into the 'Editable' widget.
--
-- * The connected signal receives the text that is inserted, together with
-- the position in the entry widget. The return value should be the position
-- in the entry widget that lies past the recently inserted text (i.e.
-- you should return the given position plus the length of the string).
--
-- * To modify the text that the user inserts, you need to connect to this
-- signal, modify the text the way you want and then call
-- 'editableInsertText'. To avoid that this signal handler is called
-- recursively, you need to temporarily block it using
-- 'signalBlock'. After the default signal
-- handler has inserted your modified text, it is important that you
-- prevent the default handler from being executed again when this signal
-- handler returns. To stop the current signal, use 'stopInsertText'.
-- The following code is an example of how to turn all input into uppercase:
--
-- > idRef <- newIORef undefined
-- > id <- entry `on` insertText $ \str pos -> do
-- > id <- readIORef idRef
-- > signalBlock id
-- > pos' <- editableInsertText entry (map toUpper str) pos
-- > signalUnblock id
-- > stopInsertText id
-- > return pos'
-- > writeIORef idRef id
--
-- Note that binding 'insertText' using 'after' is not very useful, except to
-- track editing actions.
--
insertText :: (EditableClass self, GlibString string) => Signal self (string -> Int -> IO Int)
insertText :: forall self string.
(EditableClass self, GlibString string) =>
Signal self (string -> Int -> IO Int)
insertText = (Bool -> self -> (string -> Int -> IO Int) -> IO (ConnectId self))
-> Signal self (string -> Int -> IO Int)
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal ((Bool -> self -> (string -> Int -> IO Int) -> IO (ConnectId self))
 -> Signal self (string -> Int -> IO Int))
-> (Bool
    -> self -> (string -> Int -> IO Int) -> IO (ConnectId self))
-> Signal self (string -> Int -> IO Int)
forall a b. (a -> b) -> a -> b
$ \Bool
after self
obj string -> Int -> IO Int
handler ->
  SignalName
-> Bool
-> self
-> (Ptr CChar -> Int -> Ptr CInt -> IO ())
-> IO (ConnectId self)
forall obj a c.
GObjectClass obj =>
SignalName
-> Bool
-> obj
-> (Ptr a -> Int -> Ptr c -> IO ())
-> IO (ConnectId obj)
connect_PTR_INT_PTR__NONE SignalName
"insert-text" Bool
after self
obj
  (\Ptr CChar
strPtr Int
strLen Ptr CInt
posPtr -> do
    string
str <- if Int
strLenInt -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<Int
0 then Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString Ptr CChar
strPtr
           else CStringLen -> IO string
forall s. GlibString s => CStringLen -> IO s
peekUTFStringLen (Ptr CChar
strPtr, Int
strLen)
    CInt
pos <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek (Ptr CInt
posPtr :: Ptr (CInt))
    Int
pos' <- string -> Int -> IO Int
handler string
str (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
pos)
    Ptr CInt -> CInt -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr CInt
posPtr :: Ptr (CInt)) (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
pos')
  )

-- | Stop the current signal that inserts text.
stopInsertText :: EditableClass self => ConnectId self -> IO ()
stopInsertText :: forall self. EditableClass self => ConnectId self -> IO ()
stopInsertText (ConnectId CULong
_ self
obj) =
  self -> SignalName -> IO ()
forall obj. GObjectClass obj => obj -> SignalName -> IO ()
signalStopEmission self
obj SignalName
"insert-text"

foreign import ccall safe "gtk_editable_select_region"
  gtk_editable_select_region :: ((Ptr Editable) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall unsafe "gtk_editable_get_selection_bounds"
  gtk_editable_get_selection_bounds :: ((Ptr Editable) -> ((Ptr CInt) -> ((Ptr CInt) -> (IO CInt))))

foreign import ccall safe "gtk_editable_insert_text"
  gtk_editable_insert_text :: ((Ptr Editable) -> ((Ptr CChar) -> (CInt -> ((Ptr CInt) -> (IO ())))))

foreign import ccall safe "gtk_editable_delete_text"
  gtk_editable_delete_text :: ((Ptr Editable) -> (CInt -> (CInt -> (IO ()))))

foreign import ccall unsafe "gtk_editable_get_chars"
  gtk_editable_get_chars :: ((Ptr Editable) -> (CInt -> (CInt -> (IO (Ptr CChar)))))

foreign import ccall safe "gtk_editable_cut_clipboard"
  gtk_editable_cut_clipboard :: ((Ptr Editable) -> (IO ()))

foreign import ccall safe "gtk_editable_copy_clipboard"
  gtk_editable_copy_clipboard :: ((Ptr Editable) -> (IO ()))

foreign import ccall safe "gtk_editable_paste_clipboard"
  gtk_editable_paste_clipboard :: ((Ptr Editable) -> (IO ()))

foreign import ccall safe "gtk_editable_delete_selection"
  gtk_editable_delete_selection :: ((Ptr Editable) -> (IO ()))

foreign import ccall safe "gtk_editable_set_position"
  gtk_editable_set_position :: ((Ptr Editable) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_editable_get_position"
  gtk_editable_get_position :: ((Ptr Editable) -> (IO CInt))

foreign import ccall safe "gtk_editable_set_editable"
  gtk_editable_set_editable :: ((Ptr Editable) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_editable_get_editable"
  gtk_editable_get_editable :: ((Ptr Editable) -> (IO CInt))