{-# LINE 2 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget EntryBuffer
--
-- Author : Andy Stewart
--
-- Created: 22 Mar 2010
--
-- 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)
--
-- Text buffer for 'Entry'
--
-- * Module available since Gtk+ version 2.18
--
module Graphics.UI.Gtk.Entry.EntryBuffer (

-- * Detail
--
-- | The 'EntryBuffer' class contains the actual text displayed in a 'Entry'
-- widget.
--
-- A single 'EntryBuffer' object can be shared by multiple 'Entry' widgets
-- which will then share the same text content, but not the cursor position,
-- visibility attributes, icon etc.
--
-- 'EntryBuffer' may be derived from. Such a derived class might allow text
-- to be stored in an alternate location, such as non-pageable memory, useful
-- in the case of important passwords. Or a derived class could integrate with
-- an application's concept of undo\/redo.

-- * Class Hierarchy
--
-- |
-- @
-- | 'GObject'
-- | +----EntryBuffer
-- @


-- * Types
  EntryBuffer,
  EntryBufferClass,
  castToEntryBuffer,
  toEntryBuffer,

-- * Constructors
  entryBufferNew,

-- * Methods
  entryBufferGetBytes,
  entryBufferInsertText,
  entryBufferDeleteText,
  entryBufferEmitDeletedText,
  entryBufferEmitInsertedText,

-- * Attributes
  entryBufferText,
  entryBufferLength,
  entryBufferMaxLength,

-- * Signals
  entryBufferInsertedText,
  entryBufferDeletedText,

  ) where

import Control.Monad (liftM)
import Data.Maybe (fromJust)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import System.Glib.Properties
import Graphics.UI.Gtk.Types
{-# LINE 90 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}
import Graphics.UI.Gtk.Signals
{-# LINE 91 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}


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


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

-- | Create a new 'EntryBuffer' object.
--
-- Optionally, specify initial text to set in the buffer.
--
-- * Available since Gtk+ version 2.18
--
entryBufferNew :: GlibString string
 => Maybe string -- ^ @initialChars@ - initial buffer text or 'Nothing'
 -> IO EntryBuffer
entryBufferNew :: forall string. GlibString string => Maybe string -> IO EntryBuffer
entryBufferNew Maybe string
initialChars =
  (ForeignPtr EntryBuffer -> EntryBuffer, FinalizerPtr EntryBuffer)
-> IO (Ptr EntryBuffer) -> IO EntryBuffer
forall obj.
GObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
wrapNewGObject (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
$
  (string
 -> (Ptr CChar -> IO (Ptr EntryBuffer)) -> IO (Ptr EntryBuffer))
-> Maybe string
-> (Ptr CChar -> IO (Ptr EntryBuffer))
-> IO (Ptr EntryBuffer)
forall a b c.
(a -> (Ptr b -> IO c) -> IO c)
-> Maybe a -> (Ptr b -> IO c) -> IO c
maybeWith string
-> (Ptr CChar -> IO (Ptr EntryBuffer)) -> IO (Ptr EntryBuffer)
forall a. string -> (Ptr CChar -> IO a) -> IO a
forall s a. GlibString s => s -> (Ptr CChar -> IO a) -> IO a
withUTFString Maybe string
initialChars ((Ptr CChar -> IO (Ptr EntryBuffer)) -> IO (Ptr EntryBuffer))
-> (Ptr CChar -> IO (Ptr EntryBuffer)) -> IO (Ptr EntryBuffer)
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
initialCharsPtr -> do
    let chars :: Int
chars = if Ptr CChar
initialCharsPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr
                   then (-Int
1)
                   else string -> Int
forall s. GlibString s => s -> Int
stringLength (string -> Int) -> string -> Int
forall a b. (a -> b) -> a -> b
$ Maybe string -> string
forall a. HasCallStack => Maybe a -> a
fromJust Maybe string
initialChars
    Ptr CChar -> CInt -> IO (Ptr EntryBuffer)
gtk_entry_buffer_new
{-# LINE 114 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}
      initialCharsPtr
      (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
chars)

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

-- | Retrieves the length in bytes of the buffer. See 'entryBufferGetLength'.
--
-- * Available since Gtk+ version 2.18
--
entryBufferGetBytes :: EntryBufferClass self => self
 -> IO Int -- ^ returns The byte length of the buffer.
entryBufferGetBytes :: forall self. EntryBufferClass self => self -> IO Int
entryBufferGetBytes self
self =
  (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(EntryBuffer ForeignPtr EntryBuffer
arg1) -> ForeignPtr EntryBuffer -> (Ptr EntryBuffer -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EntryBuffer
arg1 ((Ptr EntryBuffer -> IO CUInt) -> IO CUInt)
-> (Ptr EntryBuffer -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr EntryBuffer
argPtr1 ->Ptr EntryBuffer -> IO CUInt
gtk_entry_buffer_get_bytes Ptr EntryBuffer
argPtr1)
{-# LINE 129 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}
    (toEntryBuffer self)

-- | Inserts @chars@ into the contents of the buffer,
-- at position @position@.
--
-- * Available since Gtk+ version 2.18
--
entryBufferInsertText :: (EntryBufferClass self, GlibString string) => self
 -> Int -- ^ @position@ - the position at which to insert text.
 -> string -- ^ @chars@ - the text to insert into the buffer.
 -> IO Int -- ^ returns The number of characters actually inserted.
entryBufferInsertText :: forall self string.
(EntryBufferClass self, GlibString string) =>
self -> Int -> string -> IO Int
entryBufferInsertText self
self Int
position string
chars =
  (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  string -> (CStringLen -> IO CUInt) -> IO CUInt
forall a. string -> (CStringLen -> IO a) -> IO a
forall s a. GlibString s => s -> (CStringLen -> IO a) -> IO a
withUTFStringLen string
chars ((CStringLen -> IO CUInt) -> IO CUInt)
-> (CStringLen -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \ (Ptr CChar
charsPtr, Int
len) ->
  (\(EntryBuffer ForeignPtr EntryBuffer
arg1) CUInt
arg2 Ptr CChar
arg3 CInt
arg4 -> ForeignPtr EntryBuffer -> (Ptr EntryBuffer -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EntryBuffer
arg1 ((Ptr EntryBuffer -> IO CUInt) -> IO CUInt)
-> (Ptr EntryBuffer -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr EntryBuffer
argPtr1 ->Ptr EntryBuffer -> CUInt -> Ptr CChar -> CInt -> IO CUInt
gtk_entry_buffer_insert_text Ptr EntryBuffer
argPtr1 CUInt
arg2 Ptr CChar
arg3 CInt
arg4)
{-# LINE 144 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}
    (toEntryBuffer self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)
    Ptr CChar
charsPtr
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

-- | Deletes a sequence of characters from the buffer. @nChars@ characters are
-- deleted starting at @position@. If @nChars@ is negative, then all characters
-- until the end of the text are deleted.
--
-- * Available since Gtk+ version 2.18
--
entryBufferDeleteText :: EntryBufferClass self => self
 -> Int -- ^ @position@ - position at which to delete text
 -> Int -- ^ @nChars@ - number of characters to delete
 -> IO Int -- ^ returns The number of characters deleted.
entryBufferDeleteText :: forall self. EntryBufferClass self => self -> Int -> Int -> IO Int
entryBufferDeleteText self
self Int
position Int
nChars =
  (CUInt -> Int) -> IO CUInt -> IO Int
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CUInt -> IO Int) -> IO CUInt -> IO Int
forall a b. (a -> b) -> a -> b
$
  (\(EntryBuffer ForeignPtr EntryBuffer
arg1) CUInt
arg2 CInt
arg3 -> ForeignPtr EntryBuffer -> (Ptr EntryBuffer -> IO CUInt) -> IO CUInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EntryBuffer
arg1 ((Ptr EntryBuffer -> IO CUInt) -> IO CUInt)
-> (Ptr EntryBuffer -> IO CUInt) -> IO CUInt
forall a b. (a -> b) -> a -> b
$ \Ptr EntryBuffer
argPtr1 ->Ptr EntryBuffer -> CUInt -> CInt -> IO CUInt
gtk_entry_buffer_delete_text Ptr EntryBuffer
argPtr1 CUInt
arg2 CInt
arg3)
{-# LINE 162 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}
    (toEntryBuffer self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nChars)

-- | Used when subclassing 'EntryBuffer'
--
-- * Available since Gtk+ version 2.18
--
entryBufferEmitDeletedText :: EntryBufferClass self => self
 -> Int -- ^ @position@ - position at which text was deleted
 -> Int -- ^ @nChars@ - number of characters deleted
 -> IO ()
entryBufferEmitDeletedText :: forall self. EntryBufferClass self => self -> Int -> Int -> IO ()
entryBufferEmitDeletedText self
self Int
position Int
nChars =
  (\(EntryBuffer ForeignPtr EntryBuffer
arg1) CUInt
arg2 CUInt
arg3 -> ForeignPtr EntryBuffer -> (Ptr EntryBuffer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EntryBuffer
arg1 ((Ptr EntryBuffer -> IO ()) -> IO ())
-> (Ptr EntryBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr EntryBuffer
argPtr1 ->Ptr EntryBuffer -> CUInt -> CUInt -> IO ()
gtk_entry_buffer_emit_deleted_text Ptr EntryBuffer
argPtr1 CUInt
arg2 CUInt
arg3)
{-# LINE 176 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}
    (toEntryBuffer self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nChars)

-- | Used when subclassing 'EntryBuffer'
--
-- * Available since Gtk+ version 2.18
--
entryBufferEmitInsertedText :: (EntryBufferClass self, GlibString string) => self
 -> Int -- ^ @position@ - position at which text was inserted
 -> string -- ^ @chars@ - text that was inserted
 -> Int -- ^ @nChars@ - number of characters inserted
 -> IO ()
entryBufferEmitInsertedText :: forall self string.
(EntryBufferClass self, GlibString string) =>
self -> Int -> string -> Int -> IO ()
entryBufferEmitInsertedText self
self Int
position string
chars Int
nChars =
  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
chars ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
charsPtr ->
  (\(EntryBuffer ForeignPtr EntryBuffer
arg1) CUInt
arg2 Ptr CChar
arg3 CUInt
arg4 -> ForeignPtr EntryBuffer -> (Ptr EntryBuffer -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr EntryBuffer
arg1 ((Ptr EntryBuffer -> IO ()) -> IO ())
-> (Ptr EntryBuffer -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr EntryBuffer
argPtr1 ->Ptr EntryBuffer -> CUInt -> Ptr CChar -> CUInt -> IO ()
gtk_entry_buffer_emit_inserted_text Ptr EntryBuffer
argPtr1 CUInt
arg2 Ptr CChar
arg3 CUInt
arg4)
{-# LINE 192 "./Graphics/UI/Gtk/Entry/EntryBuffer.chs" #-}
    (toEntryBuffer self)
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
position)
    Ptr CChar
charsPtr
    (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
nChars)

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

-- | The contents of the buffer.
--
-- Default value: \"\"
--
-- * Available since Gtk+ version 2.18
--
entryBufferText :: (EntryBufferClass self, GlibString string) => Attr self string
entryBufferText :: forall self string.
(EntryBufferClass self, GlibString string) =>
Attr self string
entryBufferText = String -> Attr self string
forall gobj string.
(GObjectClass gobj, GlibString string) =>
String -> Attr gobj string
newAttrFromStringProperty String
"text"

-- | The length of the text in buffer.
--
-- Allowed values: <= 65535
--
-- Default value: 0
--
-- * Available since Gtk+ version 2.18
--
entryBufferLength :: EntryBufferClass self => ReadAttr self Int
entryBufferLength :: forall self. EntryBufferClass self => ReadAttr self Int
entryBufferLength = String -> ReadAttr self Int
forall gobj. GObjectClass gobj => String -> ReadAttr gobj Int
readAttrFromIntProperty String
"length"

-- | The maximum length of the text in the buffer.
--
-- Allowed values: [0,65535]
--
-- Default value: 0
--
-- * Available since Gtk+ version 2.18
--
entryBufferMaxLength :: EntryBufferClass self => Attr self Int
entryBufferMaxLength :: forall self. EntryBufferClass self => Attr self Int
entryBufferMaxLength = String -> Attr self Int
forall gobj. GObjectClass gobj => String -> Attr gobj Int
newAttrFromIntProperty String
"max-length"

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

-- |
--
-- * Available since Gtk+ version 2.18
--
entryBufferInsertedText :: (EntryBufferClass self, GlibString string) => Signal self (Int -> string -> Int -> IO ())
entryBufferInsertedText :: forall self string.
(EntryBufferClass self, GlibString string) =>
Signal self (Int -> string -> Int -> IO ())
entryBufferInsertedText = (Bool
 -> self -> (Int -> string -> Int -> IO ()) -> IO (ConnectId self))
-> Signal self (Int -> string -> Int -> IO ())
forall object handler.
(Bool -> object -> handler -> IO (ConnectId object))
-> Signal object handler
Signal (String
-> Bool
-> self
-> (Int -> string -> Int -> IO ())
-> IO (ConnectId self)
forall b' obj.
(GlibString b', GObjectClass obj) =>
String
-> Bool -> obj -> (Int -> b' -> Int -> IO ()) -> IO (ConnectId obj)
connect_INT_GLIBSTRING_INT__NONE String
"inserted_text")

-- |
--
-- * Available since Gtk+ version 2.18
--
entryBufferDeletedText :: EntryBufferClass self => Signal self (Int -> Int -> IO ())
entryBufferDeletedText :: forall self.
EntryBufferClass self =>
Signal self (Int -> Int -> IO ())
entryBufferDeletedText = (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 (String
-> Bool -> self -> (Int -> Int -> IO ()) -> IO (ConnectId self)
forall obj.
GObjectClass obj =>
String
-> Bool -> obj -> (Int -> Int -> IO ()) -> IO (ConnectId obj)
connect_INT_INT__NONE String
"deleted_text")

foreign import ccall safe "gtk_entry_buffer_new"
  gtk_entry_buffer_new :: ((Ptr CChar) -> (CInt -> (IO (Ptr EntryBuffer))))

foreign import ccall safe "gtk_entry_buffer_get_bytes"
  gtk_entry_buffer_get_bytes :: ((Ptr EntryBuffer) -> (IO CUInt))

foreign import ccall safe "gtk_entry_buffer_insert_text"
  gtk_entry_buffer_insert_text :: ((Ptr EntryBuffer) -> (CUInt -> ((Ptr CChar) -> (CInt -> (IO CUInt)))))

foreign import ccall safe "gtk_entry_buffer_delete_text"
  gtk_entry_buffer_delete_text :: ((Ptr EntryBuffer) -> (CUInt -> (CInt -> (IO CUInt))))

foreign import ccall safe "gtk_entry_buffer_emit_deleted_text"
  gtk_entry_buffer_emit_deleted_text :: ((Ptr EntryBuffer) -> (CUInt -> (CUInt -> (IO ()))))

foreign import ccall safe "gtk_entry_buffer_emit_inserted_text"
  gtk_entry_buffer_emit_inserted_text :: ((Ptr EntryBuffer) -> (CUInt -> ((Ptr CChar) -> (CUInt -> (IO ())))))