{-# LINE 2 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget Entry
--
-- Author : Axel Simon, Andy Stewart
--
-- Created: 23 May 2001
--
-- Copyright (C) 1999-2005 Axel Simon
-- Copyright (C) 2010 Andy Stewart
--
-- 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)
--
-- A single line text entry field
--
module Graphics.UI.Gtk.Entry.Entry (
-- * Detail
--
-- | The 'Entry' widget is a single line text entry widget. A fairly large set
-- of key bindings are supported by default. If the entered text is longer than
-- the allocation of the widget, the widget will scroll so that the cursor
-- position is visible.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----Entry
-- | +----'SpinButton'
-- @

-- * Types
  Entry,
  EntryClass,
  castToEntry, gTypeEntry,
  toEntry,

-- * Constructors
  entryNew,

  entryNewWithBuffer,


-- * Methods
  entrySetText,
  entryGetText,






  entrySetVisibility,
  entryGetVisibility,
  entrySetInvisibleChar,
  entryGetInvisibleChar,
  entrySetMaxLength,
  entryGetMaxLength,
  entryGetActivatesDefault,
  entrySetActivatesDefault,
  entryGetHasFrame,
  entrySetHasFrame,
  entryGetWidthChars,
  entrySetWidthChars,

  entrySetPlaceholderText,
  entryGetPlaceholderText,


  entrySetAlignment,
  entryGetAlignment,
  entrySetCompletion,
  entryGetCompletion,


  entryGetBuffer,
  entrySetBuffer,
{-# LINE 101 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
  entryImContextFilterKeypress,
  entryResetImContext,


-- * Attributes
  entryCursorPosition,
  entrySelectionBound,
  entryEditable,
  entryMaxLength,
  entryVisibility,
  entryHasFrame,
  entryInvisibleChar,
  entryActivatesDefault,
  entryWidthChars,
  entryScrollOffset,
  entryText,

  entryPlaceholderText,


  entryXalign,
  entryAlignment,
  entryCompletion,


  entryBuffer,


-- * Signals
  entryActivated,
  entryActivate,
  entryBackspace,
  entryCopyClipboard,
  entryCutClipboard,
  entryPasteClipboard,
  entryDeleteFromCursor,
  entryInsertAtCursor,
  entryMoveCursor,
  entryPopulatePopup,
  entryToggleOverwirte,
  entryToggleOverwrite,

  entryPreeditChanged,


  entryIconPress,
  entryIconRelease,


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

import Control.Monad (liftM)
import Control.Monad.Reader (runReaderT)
import Data.Char (ord, chr)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.General.Enums (DeleteType (..), MovementStep (..)

  , EntryIconPosition (..)

  )
import Graphics.UI.Gtk.Gdk.EventM (EventM, EButton, EKey)
import Control.Monad.Reader ( ask )
import Control.Monad.Trans ( liftIO )

import Graphics.UI.Gtk.Entry.EntryBuffer

import Graphics.UI.Gtk.Types
{-# LINE 186 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 187 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}


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

--------------------
-- Interfaces

instance EditableClass Entry

--------------------
-- Constructors

-- | Creates a new 'Entry' widget.
--
entryNew :: IO Entry
entryNew :: IO Entry
entryNew =
  (ForeignPtr Entry -> Entry, FinalizerPtr Entry)
-> IO (Ptr Entry) -> IO Entry
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Entry -> Entry, FinalizerPtr Entry)
forall {a}. (ForeignPtr Entry -> Entry, FinalizerPtr a)
mkEntry (IO (Ptr Entry) -> IO Entry) -> IO (Ptr Entry) -> IO Entry
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Entry) -> IO (Ptr Widget) -> IO (Ptr Entry)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Entry
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Entry) (IO (Ptr Widget) -> IO (Ptr Entry))
-> IO (Ptr Widget) -> IO (Ptr Entry)
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Widget)
gtk_entry_new
{-# LINE 205 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}


-- | Creates a new 'Entry' widget backed by a particular 'EntryBuffer'. One
-- buffer can be shared among many widgets.
--
entryNewWithBuffer :: EntryBufferClass buffer => buffer -> IO Entry
entryNewWithBuffer :: forall buffer. EntryBufferClass buffer => buffer -> IO Entry
entryNewWithBuffer buffer
buffer =
  (ForeignPtr Entry -> Entry, FinalizerPtr Entry)
-> IO (Ptr Entry) -> IO Entry
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr Entry -> Entry, FinalizerPtr Entry)
forall {a}. (ForeignPtr Entry -> Entry, FinalizerPtr a)
mkEntry (IO (Ptr Entry) -> IO Entry) -> IO (Ptr Entry) -> IO Entry
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr Entry) -> IO (Ptr Widget) -> IO (Ptr Entry)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr Entry
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr Entry) (IO (Ptr Widget) -> IO (Ptr Entry))
-> IO (Ptr Widget) -> IO (Ptr Entry)
forall a b. (a -> b) -> a -> b
$
  (\(EntryBuffer ForeignPtr EntryBuffer
arg1) -> ForeignPtr EntryBuffer
-> (Ptr EntryBuffer -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EntryBuffer
arg1 ((Ptr EntryBuffer -> IO (Ptr Widget)) -> IO (Ptr Widget))
-> (Ptr EntryBuffer -> IO (Ptr Widget)) -> IO (Ptr Widget)
forall a b. (a -> b) -> a -> b
$ \Ptr EntryBuffer
argPtr1 ->Ptr EntryBuffer -> IO (Ptr Widget)
gtk_entry_new_with_buffer Ptr EntryBuffer
argPtr1)
{-# LINE 215 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntryBuffer buffer)

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

-- Although the documentation doesn't say one way or the other, a look at the
-- source indicates that gtk_entry_get_buffer doesn't increment the reference
-- count of the GtkEntryBuffer it returns, so, like textViewGetBuffer, we must
-- increment it ourselves.

-- | Get the 'EntryBuffer' object which holds the text for this widget.
entryGetBuffer :: EntryClass self => self
  -> IO EntryBuffer
entryGetBuffer :: forall self. EntryClass self => self -> IO EntryBuffer
entryGetBuffer self
self =
  (ForeignPtr EntryBuffer -> EntryBuffer, FinalizerPtr EntryBuffer)
-> IO (Ptr EntryBuffer) -> IO EntryBuffer
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr EntryBuffer -> EntryBuffer, FinalizerPtr EntryBuffer)
forall {a}. (ForeignPtr EntryBuffer -> EntryBuffer, FinalizerPtr a)
mkEntryBuffer (IO (Ptr EntryBuffer) -> IO EntryBuffer)
-> IO (Ptr EntryBuffer) -> IO EntryBuffer
forall a b. (a -> b) -> a -> b
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry
-> (Ptr Entry -> IO (Ptr EntryBuffer)) -> IO (Ptr EntryBuffer)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO (Ptr EntryBuffer)) -> IO (Ptr EntryBuffer))
-> (Ptr Entry -> IO (Ptr EntryBuffer)) -> IO (Ptr EntryBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO (Ptr EntryBuffer)
gtk_entry_get_buffer Ptr Entry
argPtr1)
{-# LINE 231 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)

-- | Set the 'EntryBuffer' object which holds the text for this widget.
entrySetBuffer :: (EntryClass self, EntryBufferClass buffer) => self
  -> buffer -> IO ()
entrySetBuffer :: forall self buffer.
(EntryClass self, EntryBufferClass buffer) =>
self -> buffer -> IO ()
entrySetBuffer self
self =
  (\(Entry ForeignPtr Entry
arg1) (EntryBuffer ForeignPtr EntryBuffer
arg2) -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->ForeignPtr EntryBuffer -> (Ptr EntryBuffer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EntryBuffer
arg2 ((Ptr EntryBuffer -> IO ()) -> IO ())
-> (Ptr EntryBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr EntryBuffer
argPtr2 ->Ptr Entry -> Ptr EntryBuffer -> IO ()
gtk_entry_set_buffer Ptr Entry
argPtr1 Ptr EntryBuffer
argPtr2)
{-# LINE 238 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self) (EntryBuffer -> IO ())
-> (buffer -> EntryBuffer) -> buffer -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. buffer -> EntryBuffer
forall o. EntryBufferClass o => o -> EntryBuffer
toEntryBuffer


-- | Sets the text in the widget to the given value, replacing the current
-- contents.
--
entrySetText :: (EntryClass self, GlibString string) => self -> string -> IO ()
entrySetText :: forall self string.
(EntryClass self, GlibString string) =>
self -> string -> IO ()
entrySetText self
self string
text =
  string -> (CString -> IO ()) -> IO ()
forall a. string -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString string
text ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \CString
textPtr ->
  (\(Entry ForeignPtr Entry
arg1) CString
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CString -> IO ()
gtk_entry_set_text Ptr Entry
argPtr1 CString
arg2)
{-# LINE 248 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    CString
textPtr

-- | Retrieves the contents of the entry widget.
-- See also 'Graphics.UI.Gtk.Display.Entry.Editable.editableGetChars'.
--
entryGetText :: (EntryClass self, GlibString string) => self -> IO string
entryGetText :: forall self string.
(EntryClass self, GlibString string) =>
self -> IO string
entryGetText self
self =
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CString) -> IO CString)
-> (Ptr Entry -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CString
gtk_entry_get_text Ptr Entry
argPtr1)
{-# LINE 257 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
  IO CString -> (CString -> 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
>>= CString -> IO string
forall s. GlibString s => CString -> IO s
peekUTFString
{-# LINE 289 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
-- | Sets whether the contents of the entry are visible or not. When
-- visibility is set to @False@, characters are displayed as the invisible
-- char, and will also appear that way when the text in the entry widget is
-- copied elsewhere.
--
-- The default invisible char is the asterisk \'*\', but it can be changed
-- with 'entrySetInvisibleChar'.
--
entrySetVisibility :: EntryClass self => self
 -> Bool -- ^ @visible@ - @True@ if the contents of the entry are displayed
          -- as plaintext.
 -> IO ()
entrySetVisibility :: forall self. EntryClass self => self -> Bool -> IO ()
entrySetVisibility self
self Bool
visible =
  (\(Entry ForeignPtr Entry
arg1) CInt
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CInt -> IO ()
gtk_entry_set_visibility Ptr Entry
argPtr1 CInt
arg2)
{-# LINE 303 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
visible)

-- | Retrieves whether the text in @entry@ is visible. See
-- 'entrySetVisibility'.
--
entryGetVisibility :: EntryClass self => self
 -> IO Bool -- ^ returns @True@ if the text is currently visible
entryGetVisibility :: forall self. EntryClass self => self -> IO Bool
entryGetVisibility 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
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CInt) -> IO CInt)
-> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CInt
gtk_entry_get_visibility Ptr Entry
argPtr1)
{-# LINE 314 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)

-- | Sets the character to use in place of the actual text when
-- 'entrySetVisibility' has been called to set text visibility to @False@. i.e.
-- this is the character used in \"password mode\" to show the user how many
-- characters have been typed. The default invisible char is an asterisk
-- (\'*\'). If you set the invisible char to @\'\\0\'@, then the user will get
-- no feedback at all; there will be no text on the screen as they type.
--
entrySetInvisibleChar :: EntryClass self => self -> Char -> IO ()
entrySetInvisibleChar :: forall self. EntryClass self => self -> Char -> IO ()
entrySetInvisibleChar self
self Char
ch =
  (\(Entry ForeignPtr Entry
arg1) CUInt
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CUInt -> IO ()
gtk_entry_set_invisible_char Ptr Entry
argPtr1 CUInt
arg2)
{-# LINE 326 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    ((Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (Char -> Int) -> Char -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord) Char
ch)

-- | Retrieves the character displayed in place of the real characters for
-- entries with visisbility set to false. See 'entrySetInvisibleChar'.
--
entryGetInvisibleChar :: EntryClass self => self
 -> IO Char -- ^ returns the current invisible char, or @\'\\0\'@, if the
            -- entry does not show invisible text at all.
entryGetInvisibleChar :: forall self. EntryClass self => self -> IO Char
entryGetInvisibleChar self
self =
  (CUInt -> Char) -> IO CUInt -> IO Char
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> Char
chr (Int -> Char) -> (CUInt -> Int) -> CUInt -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CUInt -> IO Char) -> IO CUInt -> IO Char
forall a b. (a -> b) -> a -> b
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CUInt) -> IO CUInt)
-> (Ptr Entry -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CUInt
gtk_entry_get_invisible_char Ptr Entry
argPtr1)
{-# LINE 338 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)

-- | Sets the maximum allowed length of the contents of the widget. If the
-- current contents are longer than the given length, then they will be
-- truncated to fit.
--
entrySetMaxLength :: EntryClass self => self
 -> Int -- ^ @max@ - the maximum length of the entry, or 0 for no maximum.
          -- (other than the maximum length of entries.) The value passed in
          -- will be clamped to the range 0-65536.
 -> IO ()
entrySetMaxLength :: forall self. EntryClass self => self -> Int -> IO ()
entrySetMaxLength self
self Int
max =
  (\(Entry ForeignPtr Entry
arg1) CInt
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CInt -> IO ()
gtk_entry_set_max_length Ptr Entry
argPtr1 CInt
arg2)
{-# LINE 351 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
max)

-- | Retrieves the maximum allowed length of the text in @entry@. See
-- 'entrySetMaxLength'.
--
entryGetMaxLength :: EntryClass self => self
 -> IO Int -- ^ returns the maximum allowed number of characters in 'Entry',
           -- or 0 if there is no maximum.
entryGetMaxLength :: forall self. EntryClass self => self -> IO Int
entryGetMaxLength 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
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CInt) -> IO CInt)
-> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CInt
gtk_entry_get_max_length Ptr Entry
argPtr1)
{-# LINE 363 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)

-- | Query whether pressing return will activate the default widget.
--
entryGetActivatesDefault :: EntryClass self => self
 -> IO Bool -- ^ returns @True@ if the entry will activate the default widget
entryGetActivatesDefault :: forall self. EntryClass self => self -> IO Bool
entryGetActivatesDefault 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
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CInt) -> IO CInt)
-> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CInt
gtk_entry_get_activates_default Ptr Entry
argPtr1)
{-# LINE 372 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)

-- | If @setting@ is @True@, pressing Enter in the @entry@ will activate the
-- default widget for the window containing the entry. This usually means that
-- the dialog box containing the entry will be closed, since the default widget
-- is usually one of the dialog buttons.
--
-- (For experts: if @setting@ is @True@, the entry calls
-- 'Graphics.UI.Gtk.Windows.Window.windowActivateDefault' on the window
-- containing the entry, in the default
-- handler for the \"activate\" signal.)
--
-- This setting is useful in 'Dialog' boxes where enter should press the
-- default button.
--
entrySetActivatesDefault :: EntryClass self => self
 -> Bool -- ^ @setting@ - @True@ to activate window's default widget on Enter
          -- keypress
 -> IO ()
entrySetActivatesDefault :: forall self. EntryClass self => self -> Bool -> IO ()
entrySetActivatesDefault self
self Bool
setting =
  (\(Entry ForeignPtr Entry
arg1) CInt
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CInt -> IO ()
gtk_entry_set_activates_default Ptr Entry
argPtr1 CInt
arg2)
{-# LINE 393 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)

-- | Query if the text 'Entry' is displayed with a frame around it.
--
entryGetHasFrame :: EntryClass self => self
 -> IO Bool -- ^ returns whether the entry has a beveled frame
entryGetHasFrame :: forall self. EntryClass self => self -> IO Bool
entryGetHasFrame 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
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CInt) -> IO CInt)
-> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CInt
gtk_entry_get_has_frame Ptr Entry
argPtr1)
{-# LINE 403 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)

-- | Sets whether the entry has a beveled frame around it.
--
entrySetHasFrame :: EntryClass self => self -> Bool -> IO ()
entrySetHasFrame :: forall self. EntryClass self => self -> Bool -> IO ()
entrySetHasFrame self
self Bool
setting =
  (\(Entry ForeignPtr Entry
arg1) CInt
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CInt -> IO ()
gtk_entry_set_has_frame Ptr Entry
argPtr1 CInt
arg2)
{-# LINE 410 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    (Bool -> CInt
forall a. Num a => Bool -> a
fromBool Bool
setting)

-- | Gets the value set by 'entrySetWidthChars'.
--
entryGetWidthChars :: EntryClass self => self
 -> IO Int -- ^ returns number of chars to request space for, or negative if
           -- unset
entryGetWidthChars :: forall self. EntryClass self => self -> IO Int
entryGetWidthChars 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
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CInt) -> IO CInt)
-> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CInt
gtk_entry_get_width_chars Ptr Entry
argPtr1)
{-# LINE 421 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)

-- | Changes the size request of the entry to be about the right size for
-- @nChars@ characters. Note that it changes the size /request/, the size can
-- still be affected by how you pack the widget into containers. If @nChars@ is
-- -1, the size reverts to the default entry size.
--
-- This setting is only considered when the widget formulates its size
-- request. Make sure that it is not mapped (shown) before you change this
-- value.
--
entrySetWidthChars :: EntryClass self => self
 -> Int -- ^ @nChars@ - width in chars
 -> IO ()
entrySetWidthChars :: forall self. EntryClass self => self -> Int -> IO ()
entrySetWidthChars self
self Int
nChars =
  (\(Entry ForeignPtr Entry
arg1) CInt
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CInt -> IO ()
gtk_entry_set_width_chars Ptr Entry
argPtr1 CInt
arg2)
{-# LINE 437 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nChars)


-- | Sets text to be displayed in entry when it is empty and unfocused.
-- This can be used to give a visual hint of the expected contents of the `Entry`.
--
-- Note that since the placeholder text gets removed when the entry received
-- focus, using this feature is a bit problematic if the entry is given the
-- initial focus in a window. Sometimes this can be worked around by delaying
-- the initial focus setting until the first key event arrives.
--
-- * Available since Gtk version 3.2
--
entrySetPlaceholderText :: (EntryClass self, GlibString text) => self
 -> Maybe text -- ^ @text@ a string to be displayed when entry is empty an unfocused, or `Nothing`
 -> IO ()
entrySetPlaceholderText :: forall self text.
(EntryClass self, GlibString text) =>
self -> Maybe text -> IO ()
entrySetPlaceholderText self
self Maybe text
text =
  (text -> (CString -> IO ()) -> IO ())
-> Maybe text -> (CString -> IO ()) -> IO ()
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith text -> (CString -> IO ()) -> IO ()
forall a. text -> (CString -> IO a) -> IO a
forall s a. GlibString s => s -> (CString -> IO a) -> IO a
withUTFString Maybe text
text ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
textPtr ->
  (\(Entry ForeignPtr Entry
arg1) CString
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CString -> IO ()
gtk_entry_set_placeholder_text Ptr Entry
argPtr1 CString
arg2)
{-# LINE 457 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    CString
textPtr

-- | Retrieves the text that will be displayed when entry is empty and unfocused.
--
-- * Available since Gtk version 3.2
--
entryGetPlaceholderText :: (EntryClass self, GlibString text) => self
 -> IO (Maybe text) -- ^ returns placeholder text
entryGetPlaceholderText :: forall self text.
(EntryClass self, GlibString text) =>
self -> IO (Maybe text)
entryGetPlaceholderText self
self =
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CString) -> IO CString
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CString) -> IO CString)
-> (Ptr Entry -> IO CString) -> IO CString
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CString
gtk_entry_get_placeholder_text Ptr Entry
argPtr1)
{-# LINE 468 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
  IO CString -> (CString -> IO (Maybe text)) -> IO (Maybe text)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (CString -> IO text) -> CString -> IO (Maybe text)
forall a b. (Ptr a -> IO b) -> Ptr a -> IO (Maybe b)
maybePeek CString -> IO text
forall s. GlibString s => CString -> IO s
peekUTFString



-- | Sets the alignment for the contents of the entry. This controls the
-- horizontal positioning of the contents when the displayed text is shorter
-- than the width of the entry.
--
-- * Available since Gtk version 2.4
--
entrySetAlignment :: EntryClass self => self
 -> Float -- ^ @xalign@ - The horizontal alignment, from 0 (left) to 1
          -- (right). Reversed for RTL layouts
 -> IO ()
entrySetAlignment :: forall self. EntryClass self => self -> Float -> IO ()
entrySetAlignment self
self Float
xalign =
  (\(Entry ForeignPtr Entry
arg1) CFloat
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> CFloat -> IO ()
gtk_entry_set_alignment Ptr Entry
argPtr1 CFloat
arg2)
{-# LINE 485 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    (Float -> CFloat
forall a b. (Real a, Fractional b) => a -> b
realToFrac Float
xalign)

-- | Gets the value set by 'entrySetAlignment'.
--
-- * Available since Gtk version 2.4
--
entryGetAlignment :: EntryClass self => self
 -> IO Float -- ^ returns the alignment
entryGetAlignment :: forall self. EntryClass self => self -> IO Float
entryGetAlignment self
self =
  (CFloat -> Float) -> IO CFloat -> IO Float
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (IO CFloat -> IO Float) -> IO CFloat -> IO Float
forall a b. (a -> b) -> a -> b
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO CFloat) -> IO CFloat
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CFloat) -> IO CFloat)
-> (Ptr Entry -> IO CFloat) -> IO CFloat
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO CFloat
gtk_entry_get_alignment Ptr Entry
argPtr1)
{-# LINE 497 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)

-- | Sets the auxiliary completion object to use with the entry. All further
-- configuration of the completion mechanism is done on completion using the
-- 'EntryCompletion' API.
--
-- * Available since Gtk version 2.4
--
entrySetCompletion :: EntryClass self => self -> EntryCompletion -> IO ()
entrySetCompletion :: forall self. EntryClass self => self -> EntryCompletion -> IO ()
entrySetCompletion self
self EntryCompletion
completion =
  (\(Entry ForeignPtr Entry
arg1) (EntryCompletion ForeignPtr EntryCompletion
arg2) -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->ForeignPtr EntryCompletion
-> (Ptr EntryCompletion -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EntryCompletion
arg2 ((Ptr EntryCompletion -> IO ()) -> IO ())
-> (Ptr EntryCompletion -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr EntryCompletion
argPtr2 ->Ptr Entry -> Ptr EntryCompletion -> IO ()
gtk_entry_set_completion Ptr Entry
argPtr1 Ptr EntryCompletion
argPtr2)
{-# LINE 508 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
    EntryCompletion
completion

-- | Returns the auxiliary completion object currently in use by the entry.
--
-- * Available since Gtk version 2.4
--
entryGetCompletion :: EntryClass self => self
 -> IO EntryCompletion -- ^ returns The auxiliary completion object currently
                       -- in use by @entry@.
entryGetCompletion :: forall self. EntryClass self => self -> IO EntryCompletion
entryGetCompletion self
self =
  (ForeignPtr EntryCompletion -> EntryCompletion,
 FinalizerPtr EntryCompletion)
-> IO (Ptr EntryCompletion) -> IO EntryCompletion
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewGObject (ForeignPtr EntryCompletion -> EntryCompletion,
 FinalizerPtr EntryCompletion)
forall {a}.
(ForeignPtr EntryCompletion -> EntryCompletion, FinalizerPtr a)
mkEntryCompletion (IO (Ptr EntryCompletion) -> IO EntryCompletion)
-> IO (Ptr EntryCompletion) -> IO EntryCompletion
forall a b. (a -> b) -> a -> b
$
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry
-> (Ptr Entry -> IO (Ptr EntryCompletion))
-> IO (Ptr EntryCompletion)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO (Ptr EntryCompletion))
 -> IO (Ptr EntryCompletion))
-> (Ptr Entry -> IO (Ptr EntryCompletion))
-> IO (Ptr EntryCompletion)
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO (Ptr EntryCompletion)
gtk_entry_get_completion Ptr Entry
argPtr1)
{-# LINE 521 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
    (toEntry self)
{-# LINE 557 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
-- | Allow the 'Entry' 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. See
-- 'imContextFilterKeypress'.
--
-- Note that you are expected to call this function from your handler when overriding key event
-- handling. This is needed in the case when you need to insert your own key handling between the input
-- method and the default key event handling of the 'Entry'. See 'textViewResetImContext' for
-- an example of use.
--
-- * Available since Gtk+ version 2.22
--
entryImContextFilterKeypress :: EntryClass self => self -> EventM EKey Bool
entryImContextFilterKeypress :: forall self. EntryClass self => self -> EventM EKey Bool
entryImContextFilterKeypress self
self = do
  Ptr EKey
ptr <- ReaderT (Ptr EKey) IO (Ptr EKey)
forall r (m :: * -> *). MonadReader r m => m r
ask
  IO Bool -> EventM EKey Bool
forall a. IO a -> ReaderT (Ptr EKey) IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> EventM EKey Bool) -> IO Bool -> EventM EKey Bool
forall a b. (a -> b) -> a -> b
$ (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
$
    (\(Entry ForeignPtr Entry
arg1) Ptr ()
arg2 -> ForeignPtr Entry -> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO CInt) -> IO CInt)
-> (Ptr Entry -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> Ptr () -> IO CInt
gtk_entry_im_context_filter_keypress Ptr Entry
argPtr1 Ptr ()
arg2)
{-# LINE 573 "./Graphics/UI/Gtk/Entry/Entry.chs" #-}
      (toEntry self)
      (Ptr EKey -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr EKey
ptr)

-- | Reset the input method context of the entry if needed.
--
-- This can be necessary in the case where modifying the buffer would confuse on-going input method
-- behavior.
--
-- * Available since Gtk+ version 2.22
--
entryResetImContext :: EntryClass self => self -> IO ()
entryResetImContext :: forall self. EntryClass self => self -> IO ()
entryResetImContext self
self =
  (\(Entry ForeignPtr Entry
arg1) -> ForeignPtr Entry -> (Ptr Entry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Entry
arg1 ((Ptr Entry -> IO ()) -> IO ()) -> (Ptr Entry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Entry
argPtr1 ->Ptr Entry -> IO ()
gtk_entry_reset_im_context Ptr Entry
argPtr1) (self -> Entry
forall o. EntryClass o => o -> Entry
toEntry self
self)


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

-- | The current position of the insertion cursor in chars.
--
-- Allowed values: [0,65535]
--
-- Default value: 0
--
entryCursorPosition :: EntryClass self => ReadAttr self Int
entryCursorPosition :: forall self. EntryClass self => ReadAttr self Int
entryCursorPosition = String -> ReadAttr self Int
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromIntProperty String
"cursor-position"

-- | The position of the opposite end of the selection from the cursor in
-- chars.
--
-- Allowed values: [0,65535]
--
-- Default value: 0
--
entrySelectionBound :: EntryClass self => ReadAttr self Int
entrySelectionBound :: forall self. EntryClass self => ReadAttr self Int
entrySelectionBound = String -> ReadAttr self Int
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromIntProperty String
"selection-bound"

-- | Whether the entry contents can be edited.
--
-- Default value: @True@
--
entryEditable :: EntryClass self => Attr self Bool
entryEditable :: forall self. EntryClass self => Attr self Bool
entryEditable = String -> Attr self Bool
forall gobj. GObjectClass gobj => String -> Attr gobj Bool
newAttrFromBoolProperty String
"editable"

-- | Maximum number of characters for this entry. Zero if no maximum.
--
-- Allowed values: [0,65535]
--
-- Default value: 0
--
entryMaxLength :: EntryClass self => Attr self Int
entryMaxLength :: forall self. EntryClass self => Attr self Int
entryMaxLength = (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. EntryClass self => self -> IO Int
entryGetMaxLength
  self -> Int -> IO ()
forall self. EntryClass self => self -> Int -> IO ()
entrySetMaxLength

-- | @False@ displays the \"invisible char\" instead of the actual text
-- (password mode).
--
-- Default value: @True@
--
entryVisibility :: EntryClass self => Attr self Bool
entryVisibility :: forall self. EntryClass self => Attr self Bool
entryVisibility = (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. EntryClass self => self -> IO Bool
entryGetVisibility
  self -> Bool -> IO ()
forall self. EntryClass self => self -> Bool -> IO ()
entrySetVisibility

-- | @False@ removes outside bevel from entry.
--
-- Default value: @True@
--
entryHasFrame :: EntryClass self => Attr self Bool
entryHasFrame :: forall self. EntryClass self => Attr self Bool
entryHasFrame = (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. EntryClass self => self -> IO Bool
entryGetHasFrame
  self -> Bool -> IO ()
forall self. EntryClass self => self -> Bool -> IO ()
entrySetHasFrame

-- | The character to use when masking entry contents (in \"password mode\").
--
-- Default value: \'*\'
--
entryInvisibleChar :: EntryClass self => Attr self Char
entryInvisibleChar :: forall self. EntryClass self => Attr self Char
entryInvisibleChar = (self -> IO Char)
-> (self -> Char -> IO ()) -> ReadWriteAttr self Char Char
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Char
forall self. EntryClass self => self -> IO Char
entryGetInvisibleChar
  self -> Char -> IO ()
forall self. EntryClass self => self -> Char -> IO ()
entrySetInvisibleChar

-- | Whether to activate the default widget (such as the default button in a
-- dialog) when Enter is pressed.
--
-- Default value: @False@
--
entryActivatesDefault :: EntryClass self => Attr self Bool
entryActivatesDefault :: forall self. EntryClass self => Attr self Bool
entryActivatesDefault = (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. EntryClass self => self -> IO Bool
entryGetActivatesDefault
  self -> Bool -> IO ()
forall self. EntryClass self => self -> Bool -> IO ()
entrySetActivatesDefault

-- | Number of characters to leave space for in the entry.
--
-- Allowed values: >= -1
--
-- Default value: -1
--
entryWidthChars :: EntryClass self => Attr self Int
entryWidthChars :: forall self. EntryClass self => Attr self Int
entryWidthChars = (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. EntryClass self => self -> IO Int
entryGetWidthChars
  self -> Int -> IO ()
forall self. EntryClass self => self -> Int -> IO ()
entrySetWidthChars

-- | Number of pixels of the entry scrolled off the screen to the left.
--
-- Allowed values: >= 0
--
-- Default value: 0
--
entryScrollOffset :: EntryClass self => ReadAttr self Int
entryScrollOffset :: forall self. EntryClass self => ReadAttr self Int
entryScrollOffset = String -> ReadAttr self Int
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromIntProperty String
"scroll-offset"

-- | The contents of the entry.
--
-- Default value: \"\"
--
entryText :: (EntryClass self, GlibString string) => Attr self string
entryText :: forall self string.
(EntryClass self, GlibString string) =>
Attr self string
entryText = (self -> IO string)
-> (self -> string -> IO ()) -> ReadWriteAttr self string string
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO string
forall self string.
(EntryClass self, GlibString string) =>
self -> IO string
entryGetText
  self -> string -> IO ()
forall self string.
(EntryClass self, GlibString string) =>
self -> string -> IO ()
entrySetText


-- | The text that will be displayed in the `Entry` when it is empty and unfocused.
--
-- Default value: Nothing
--
entryPlaceholderText :: (EntryClass self, GlibString text) => Attr self (Maybe text)
entryPlaceholderText :: forall self text.
(EntryClass self, GlibString text) =>
Attr self (Maybe text)
entryPlaceholderText = (self -> IO (Maybe text))
-> (self -> Maybe text -> IO ())
-> ReadWriteAttr self (Maybe text) (Maybe text)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO (Maybe text)
forall self text.
(EntryClass self, GlibString text) =>
self -> IO (Maybe text)
entryGetPlaceholderText
  self -> Maybe text -> IO ()
forall self text.
(EntryClass self, GlibString text) =>
self -> Maybe text -> IO ()
entrySetPlaceholderText



-- | The horizontal alignment, from 0 (left) to 1 (right). Reversed for RTL
-- layouts.
--
-- Allowed values: [0,1]
--
-- Default value: 0
--
entryXalign :: EntryClass self => Attr self Float
entryXalign :: forall self. EntryClass self => Attr self Float
entryXalign = String -> Attr self Float
forall gobj. GObjectClass gobj => String -> Attr gobj Float
newAttrFromFloatProperty String
"xalign"

-- | \'alignment\' property. See 'entryGetAlignment' and 'entrySetAlignment'
--
entryAlignment :: EntryClass self => Attr self Float
entryAlignment :: forall self. EntryClass self => Attr self Float
entryAlignment = (self -> IO Float)
-> (self -> Float -> IO ()) -> ReadWriteAttr self Float Float
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO Float
forall self. EntryClass self => self -> IO Float
entryGetAlignment
  self -> Float -> IO ()
forall self. EntryClass self => self -> Float -> IO ()
entrySetAlignment

-- | \'completion\' property. See 'entryGetCompletion' and
-- 'entrySetCompletion'
--
entryCompletion :: EntryClass self => Attr self EntryCompletion
entryCompletion :: forall self. EntryClass self => Attr self EntryCompletion
entryCompletion = (self -> IO EntryCompletion)
-> (self -> EntryCompletion -> IO ())
-> ReadWriteAttr self EntryCompletion EntryCompletion
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO EntryCompletion
forall self. EntryClass self => self -> IO EntryCompletion
entryGetCompletion
  self -> EntryCompletion -> IO ()
forall self. EntryClass self => self -> EntryCompletion -> IO ()
entrySetCompletion



-- | The buffer being displayed.
--
entryBuffer :: (EntryClass self, EntryBufferClass buffer) =>
  ReadWriteAttr self EntryBuffer buffer
entryBuffer :: forall self buffer.
(EntryClass self, EntryBufferClass buffer) =>
ReadWriteAttr self EntryBuffer buffer
entryBuffer = (self -> IO EntryBuffer)
-> (self -> buffer -> IO ())
-> ReadWriteAttr self EntryBuffer buffer
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO EntryBuffer
forall self. EntryClass self => self -> IO EntryBuffer
entryGetBuffer
  self -> buffer -> IO ()
forall self buffer.
(EntryClass self, EntryBufferClass buffer) =>
self -> buffer -> IO ()
entrySetBuffer



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

-- | A keybinding signal which gets emitted when the user activates the entry.
--
-- Applications should not connect to it, but may emit it with 'signalEmitByName' if they need to
-- control activation programmatically.
entryActivated :: EntryClass ec => Signal ec (IO ())
entryActivated :: forall ec. EntryClass ec => Signal ec (IO ())
entryActivated = (Bool -> ec -> IO () -> IO (ConnectId ec)) -> Signal ec (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> IO () -> IO (ConnectId ec)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"activate")

-- | Deprecated. See 'entryActivated'.
entryActivate :: EntryClass ec => Signal ec (IO ())
entryActivate :: forall ec. EntryClass ec => Signal ec (IO ())
entryActivate = Signal ec (IO ())
forall ec. EntryClass ec => Signal ec (IO ())
entryActivated

-- | The 'entryBackspace' signal is a keybinding signal which gets emitted when the user asks for it.
--
-- The default bindings for this signal are Backspace and Shift-Backspace.
entryBackspace :: EntryClass ec => Signal ec (IO ())
entryBackspace :: forall ec. EntryClass ec => Signal ec (IO ())
entryBackspace = (Bool -> ec -> IO () -> IO (ConnectId ec)) -> Signal ec (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> IO () -> IO (ConnectId ec)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"backspace")

-- | The 'entryCopyClipboard' signal is a keybinding signal which gets emitted to copy the selection to the
-- clipboard.
--
-- The default bindings for this signal are Ctrl-c and Ctrl-Insert.
entryCopyClipboard :: EntryClass ec => Signal ec (IO ())
entryCopyClipboard :: forall ec. EntryClass ec => Signal ec (IO ())
entryCopyClipboard = (Bool -> ec -> IO () -> IO (ConnectId ec)) -> Signal ec (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> IO () -> IO (ConnectId ec)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"copy-clipboard")

-- | The 'entryCutClipboard' signal is a keybinding signal which gets emitted to cut the selection to the
-- clipboard.
--
-- The default bindings for this signal are Ctrl-x and Shift-Delete.
entryCutClipboard :: EntryClass ec => Signal ec (IO ())
entryCutClipboard :: forall ec. EntryClass ec => Signal ec (IO ())
entryCutClipboard = (Bool -> ec -> IO () -> IO (ConnectId ec)) -> Signal ec (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> IO () -> IO (ConnectId ec)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"cut-clipboard")

-- | The 'entryDeleteFromCursor' signal is a keybinding signal which gets emitted when the user initiates a
-- text deletion.
--
-- If the type is 'DeleteChars', GTK+ deletes the selection if there is one, otherwise it deletes
-- the requested number of characters.
--
-- The default bindings for this signal are Delete for deleting a character and Ctrl-Delete for
-- deleting a word.
entryDeleteFromCursor :: EntryClass ec => Signal ec (DeleteType -> Int -> IO ())
entryDeleteFromCursor :: forall ec. EntryClass ec => Signal ec (DeleteType -> Int -> IO ())
entryDeleteFromCursor = (Bool -> ec -> (DeleteType -> Int -> IO ()) -> IO (ConnectId ec))
-> Signal ec (DeleteType -> Int -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool -> ec -> (DeleteType -> Int -> IO ()) -> IO (ConnectId ec)
forall a obj.
(Enum a, GObjectClass obj) =>
String -> Bool -> obj -> (a -> Int -> IO ()) -> IO (ConnectId obj)
connect_ENUM_INT__NONE String
"delete-from-cursor")

-- | The 'entryInsertAtCursor' signal is a keybinding signal which gets emitted when the user initiates the
-- insertion of a fixed string at the cursor.
entryInsertAtCursor :: (EntryClass ec, GlibString string) => Signal ec (string -> IO ())
entryInsertAtCursor :: forall ec string.
(EntryClass ec, GlibString string) =>
Signal ec (string -> IO ())
entryInsertAtCursor = (Bool -> ec -> (string -> IO ()) -> IO (ConnectId ec))
-> Signal ec (string -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> (string -> IO ()) -> IO (ConnectId ec)
forall a' obj.
(GlibString a', GObjectClass obj) =>
String -> Bool -> obj -> (a' -> IO ()) -> IO (ConnectId obj)
connect_GLIBSTRING__NONE String
"insert-at-cursor")

-- | The 'entryMoveCursor' signal is a keybinding signal which gets emitted when the user initiates a cursor
-- movement. If the cursor is not visible in entry, this signal causes the viewport to be moved
-- instead.
--
-- Applications should not connect to it, but may emit it with 'signalEmitByName' if they need to
-- control the cursor programmatically.
--
-- The default bindings for this signal come in two variants, the variant with the Shift modifier
-- extends the selection, the variant without the Shift modifier does not. There are too many key
-- combinations to list them all here.
--
-- * Arrow keys move by individual characters\/lines
-- * Ctrl-arrow key combinations move by words\/paragraphs
-- * Home\/End keys move to the ends of the buffer
entryMoveCursor :: EntryClass ec => Signal ec (MovementStep -> Int -> Bool -> IO ())
entryMoveCursor :: forall ec.
EntryClass ec =>
Signal ec (MovementStep -> Int -> Bool -> IO ())
entryMoveCursor = (Bool
 -> ec
 -> (MovementStep -> Int -> Bool -> IO ())
 -> IO (ConnectId ec))
-> Signal ec (MovementStep -> Int -> Bool -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool
-> ec
-> (MovementStep -> Int -> Bool -> IO ())
-> IO (ConnectId ec)
forall a obj.
(Enum a, GObjectClass obj) =>
String
-> Bool -> obj -> (a -> Int -> Bool -> IO ()) -> IO (ConnectId obj)
connect_ENUM_INT_BOOL__NONE String
"move-cursor")

-- | The 'entryPasteClipboard' signal is a keybinding signal which gets emitted to paste the contents of the
-- clipboard into the text view.
--
-- The default bindings for this signal are Ctrl-v and Shift-Insert.
entryPasteClipboard :: EntryClass ec => Signal ec (IO ())
entryPasteClipboard :: forall ec. EntryClass ec => Signal ec (IO ())
entryPasteClipboard = (Bool -> ec -> IO () -> IO (ConnectId ec)) -> Signal ec (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> IO () -> IO (ConnectId ec)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"paste-clipboard")

-- | The 'entryPopulatePopup' signal gets emitted before showing the context menu of the entry.
--
-- If you need to add items to the context menu, connect to this signal and append your menuitems to
-- the menu.
entryPopulatePopup :: EntryClass ec => Signal ec (Menu -> IO ())
entryPopulatePopup :: forall ec. EntryClass ec => Signal ec (Menu -> IO ())
entryPopulatePopup = (Bool -> ec -> (Menu -> IO ()) -> IO (ConnectId ec))
-> Signal ec (Menu -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> (Menu -> IO ()) -> IO (ConnectId ec)
forall a' obj.
(GObjectClass a', GObjectClass obj) =>
String -> Bool -> obj -> (a' -> IO ()) -> IO (ConnectId obj)
connect_OBJECT__NONE String
"populate-popup")


-- | If an input method is used, the typed text will not immediately be committed to the buffer. So if
-- you are interested in the text, connect to this signal.
entryPreeditChanged :: (EntryClass ec, GlibString string) => Signal ec (string -> IO ())
entryPreeditChanged :: forall ec string.
(EntryClass ec, GlibString string) =>
Signal ec (string -> IO ())
entryPreeditChanged = (Bool -> ec -> (string -> IO ()) -> IO (ConnectId ec))
-> Signal ec (string -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> (string -> IO ()) -> IO (ConnectId ec)
forall a' obj.
(GlibString a', GObjectClass obj) =>
String -> Bool -> obj -> (a' -> IO ()) -> IO (ConnectId obj)
connect_GLIBSTRING__NONE String
"preedit-changed")



-- | The 'iconPress' signal is emitted when an activatable icon is clicked.
--
entryIconPress :: EntryClass ec =>
                    Signal ec (EntryIconPosition -> EventM EButton ())
entryIconPress :: forall ec.
EntryClass ec =>
Signal ec (EntryIconPosition -> EventM EButton ())
entryIconPress = (Bool
 -> ec
 -> (EntryIconPosition -> EventM EButton ())
 -> IO (ConnectId ec))
-> Signal ec (EntryIconPosition -> EventM EButton ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal ((Bool
  -> ec
  -> (EntryIconPosition -> EventM EButton ())
  -> IO (ConnectId ec))
 -> Signal ec (EntryIconPosition -> EventM EButton ()))
-> (Bool
    -> ec
    -> (EntryIconPosition -> EventM EButton ())
    -> IO (ConnectId ec))
-> Signal ec (EntryIconPosition -> EventM EButton ())
forall a b. (a -> b) -> a -> b
$ \Bool
after ec
obj EntryIconPosition -> EventM EButton ()
f ->
  String
-> Bool
-> ec
-> (EntryIconPosition -> Ptr EButton -> IO ())
-> IO (ConnectId ec)
forall a obj b.
(Enum a, GObjectClass obj) =>
String
-> Bool -> obj -> (a -> Ptr b -> IO ()) -> IO (ConnectId obj)
connect_ENUM_PTR__NONE String
"icon-press" Bool
after ec
obj (EventM EButton () -> Ptr EButton -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventM EButton () -> Ptr EButton -> IO ())
-> (EntryIconPosition -> EventM EButton ())
-> EntryIconPosition
-> Ptr EButton
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> EventM EButton ()
f)

-- | The 'iconRelease' signal is emitted on the button release from a mouse click over an activatable
-- icon.
--
entryIconRelease :: EntryClass ec =>
                      Signal ec (EntryIconPosition -> EventM EButton ())
entryIconRelease :: forall ec.
EntryClass ec =>
Signal ec (EntryIconPosition -> EventM EButton ())
entryIconRelease = (Bool
 -> ec
 -> (EntryIconPosition -> EventM EButton ())
 -> IO (ConnectId ec))
-> Signal ec (EntryIconPosition -> EventM EButton ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal ((Bool
  -> ec
  -> (EntryIconPosition -> EventM EButton ())
  -> IO (ConnectId ec))
 -> Signal ec (EntryIconPosition -> EventM EButton ()))
-> (Bool
    -> ec
    -> (EntryIconPosition -> EventM EButton ())
    -> IO (ConnectId ec))
-> Signal ec (EntryIconPosition -> EventM EButton ())
forall a b. (a -> b) -> a -> b
$ \Bool
after ec
obj EntryIconPosition -> EventM EButton ()
f ->
  String
-> Bool
-> ec
-> (EntryIconPosition -> Ptr EButton -> IO ())
-> IO (ConnectId ec)
forall a obj b.
(Enum a, GObjectClass obj) =>
String
-> Bool -> obj -> (a -> Ptr b -> IO ()) -> IO (ConnectId obj)
connect_ENUM_PTR__NONE String
"icon-press" Bool
after ec
obj (EventM EButton () -> Ptr EButton -> IO ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (EventM EButton () -> Ptr EButton -> IO ())
-> (EntryIconPosition -> EventM EButton ())
-> EntryIconPosition
-> Ptr EButton
-> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EntryIconPosition -> EventM EButton ()
f)


{-# DEPRECATED entryToggleOverwirte "Use entryToggleOverwrite" #-}
entryToggleOverwirte :: EntryClass ec => Signal ec (IO ())
entryToggleOverwirte :: forall ec. EntryClass ec => Signal ec (IO ())
entryToggleOverwirte = Signal ec (IO ())
forall ec. EntryClass ec => Signal ec (IO ())
entryToggleOverwrite

-- | The 'entryToggleOverwrite' signal is a keybinding signal which gets emitted to toggle the overwrite mode
-- of the entry.
-- The default bindings for this signal is Insert.
--
entryToggleOverwrite :: EntryClass ec => Signal ec (IO ())
entryToggleOverwrite :: forall ec. EntryClass ec => Signal ec (IO ())
entryToggleOverwrite = (Bool -> ec -> IO () -> IO (ConnectId ec)) -> Signal ec (IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String -> Bool -> ec -> IO () -> IO (ConnectId ec)
forall obj.
GObjectClass obj =>
String -> Bool -> obj -> IO () -> IO (ConnectId obj)
connect_NONE__NONE String
"toggle-overwrite")

foreign import ccall unsafe "gtk_entry_new"
  gtk_entry_new :: (IO (Ptr Widget))

foreign import ccall unsafe "gtk_entry_new_with_buffer"
  gtk_entry_new_with_buffer :: ((Ptr EntryBuffer) -> (IO (Ptr Widget)))

foreign import ccall safe "gtk_entry_get_buffer"
  gtk_entry_get_buffer :: ((Ptr Entry) -> (IO (Ptr EntryBuffer)))

foreign import ccall safe "gtk_entry_set_buffer"
  gtk_entry_set_buffer :: ((Ptr Entry) -> ((Ptr EntryBuffer) -> (IO ())))

foreign import ccall safe "gtk_entry_set_text"
  gtk_entry_set_text :: ((Ptr Entry) -> ((Ptr CChar) -> (IO ())))

foreign import ccall safe "gtk_entry_get_text"
  gtk_entry_get_text :: ((Ptr Entry) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_entry_set_visibility"
  gtk_entry_set_visibility :: ((Ptr Entry) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_entry_get_visibility"
  gtk_entry_get_visibility :: ((Ptr Entry) -> (IO CInt))

foreign import ccall unsafe "gtk_entry_set_invisible_char"
  gtk_entry_set_invisible_char :: ((Ptr Entry) -> (CUInt -> (IO ())))

foreign import ccall unsafe "gtk_entry_get_invisible_char"
  gtk_entry_get_invisible_char :: ((Ptr Entry) -> (IO CUInt))

foreign import ccall safe "gtk_entry_set_max_length"
  gtk_entry_set_max_length :: ((Ptr Entry) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_entry_get_max_length"
  gtk_entry_get_max_length :: ((Ptr Entry) -> (IO CInt))

foreign import ccall unsafe "gtk_entry_get_activates_default"
  gtk_entry_get_activates_default :: ((Ptr Entry) -> (IO CInt))

foreign import ccall safe "gtk_entry_set_activates_default"
  gtk_entry_set_activates_default :: ((Ptr Entry) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_entry_get_has_frame"
  gtk_entry_get_has_frame :: ((Ptr Entry) -> (IO CInt))

foreign import ccall safe "gtk_entry_set_has_frame"
  gtk_entry_set_has_frame :: ((Ptr Entry) -> (CInt -> (IO ())))

foreign import ccall unsafe "gtk_entry_get_width_chars"
  gtk_entry_get_width_chars :: ((Ptr Entry) -> (IO CInt))

foreign import ccall safe "gtk_entry_set_width_chars"
  gtk_entry_set_width_chars :: ((Ptr Entry) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_entry_set_placeholder_text"
  gtk_entry_set_placeholder_text :: ((Ptr Entry) -> ((Ptr CChar) -> (IO ())))

foreign import ccall unsafe "gtk_entry_get_placeholder_text"
  gtk_entry_get_placeholder_text :: ((Ptr Entry) -> (IO (Ptr CChar)))

foreign import ccall safe "gtk_entry_set_alignment"
  gtk_entry_set_alignment :: ((Ptr Entry) -> (CFloat -> (IO ())))

foreign import ccall unsafe "gtk_entry_get_alignment"
  gtk_entry_get_alignment :: ((Ptr Entry) -> (IO CFloat))

foreign import ccall safe "gtk_entry_set_completion"
  gtk_entry_set_completion :: ((Ptr Entry) -> ((Ptr EntryCompletion) -> (IO ())))

foreign import ccall safe "gtk_entry_get_completion"
  gtk_entry_get_completion :: ((Ptr Entry) -> (IO (Ptr EntryCompletion)))

foreign import ccall safe "gtk_entry_im_context_filter_keypress"
  gtk_entry_im_context_filter_keypress :: ((Ptr Entry) -> ((Ptr ()) -> (IO CInt)))

foreign import ccall safe "gtk_entry_reset_im_context"
  gtk_entry_reset_im_context :: ((Ptr Entry) -> (IO ()))