{-# LINE 2 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
-- -*-haskell-*-
-- GIMP Toolkit (GTK) Widget ComboBoxEntry
--
-- Author : Duncan Coutts
--
-- Created: 25 April 2004
--
-- Copyright (C) 2004-2005 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)
--
-- A text entry field with a dropdown list
--
-- * Module available since Gtk+ version 2.4
--
module Graphics.UI.Gtk.MenuComboToolbar.ComboBoxEntry (
-- * Detail
--
-- | A 'ComboBoxEntry' is a widget that allows the user to choose from a list
-- of valid choices or enter a different value. It is very similar to a
-- 'ComboBox', but it displays the selected value in an entry to allow
-- modifying it.
--
-- In contrast to a 'ComboBox', the underlying model of a 'ComboBoxEntry' must
-- always have a text column (see 'comboBoxEntrySetTextColumn'), and the entry
-- will show the content of the text column in the selected row. To get the
-- text from the entry, use 'comboBoxEntryGetActiveText'.
--
-- The 'Graphics.UI.Gtk.MenuComboToolbar.ComboBox.changed' signal will be
-- emitted while typing into a 'ComboBoxEntry', as well as when selecting an
-- item from the 'ComboBoxEntry''s list. Use 'comboBoxGetActive' or
-- 'comboBoxGetActiveIter' to discover whether an item was actually selected
-- from the list.
--
-- Connect to the activate signal of the 'Entry' (use 'binGetChild') to detect
-- when the user actually finishes entering text.
--
-- * This module is deprecated and the functionality removed in Gtk3. It is
-- therefore empty in Gtk3.

-- * Class Hierarchy
-- |
-- @
-- | 'GObject'
-- | +----'Object'
-- | +----'Widget'
-- | +----'Container'
-- | +----'Bin'
-- | +----'ComboBox'
-- | +----ComboBoxEntry
-- @



-- * Types
  ComboBoxEntry,
  ComboBoxEntryClass,
  castToComboBoxEntry, gTypeComboBoxEntry,
  toComboBoxEntry,

-- * Constructors
  comboBoxEntryNew,
  comboBoxEntryNewText,
  comboBoxEntryNewWithModel,

-- * Methods
  comboBoxEntrySetModelText,

  comboBoxEntrySetTextColumn,
  comboBoxEntryGetTextColumn,

  comboBoxEntryGetActiveText,


-- * Attributes
  comboBoxEntryTextColumn,


  ) where


import Control.Monad (liftM)

import System.Glib.FFI
import System.Glib.UTFString
import System.Glib.Attributes
import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
import Graphics.UI.Gtk.Types hiding ( ListStore )
import Graphics.UI.Gtk.ModelView.Types
import Graphics.UI.Gtk.MenuComboToolbar.ComboBox
import Graphics.UI.Gtk.ModelView.CustomStore
{-# LINE 106 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
import Graphics.UI.Gtk.ModelView.TreeModel
{-# LINE 107 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
import Graphics.UI.Gtk.ModelView.ListStore ( ListStore, listStoreNew )


{-# LINE 110 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}


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

-- | Creates a new 'ComboBoxEntry' which has a 'Entry' as child. After
-- construction, you should set a model using 'comboBoxSetModel' and a
-- text column using 'comboBoxEntrySetTextColumn'.
--
comboBoxEntryNew :: IO ComboBoxEntry
comboBoxEntryNew :: IO ComboBoxEntry
comboBoxEntryNew =
  (ForeignPtr ComboBoxEntry -> ComboBoxEntry,
 FinalizerPtr ComboBoxEntry)
-> IO (Ptr ComboBoxEntry) -> IO ComboBoxEntry
forall obj.
ObjectClass obj =>
(ForeignPtr obj -> obj, FinalizerPtr obj) -> IO (Ptr obj) -> IO obj
makeNewObject (ForeignPtr ComboBoxEntry -> ComboBoxEntry,
 FinalizerPtr ComboBoxEntry)
forall {a}.
(ForeignPtr ComboBoxEntry -> ComboBoxEntry, FinalizerPtr a)
mkComboBoxEntry (IO (Ptr ComboBoxEntry) -> IO ComboBoxEntry)
-> IO (Ptr ComboBoxEntry) -> IO ComboBoxEntry
forall a b. (a -> b) -> a -> b
$
  (Ptr Widget -> Ptr ComboBoxEntry)
-> IO (Ptr Widget) -> IO (Ptr ComboBoxEntry)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Ptr Widget -> Ptr ComboBoxEntry
forall a b. Ptr a -> Ptr b
castPtr :: Ptr Widget -> Ptr ComboBoxEntry) (IO (Ptr Widget) -> IO (Ptr ComboBoxEntry))
-> IO (Ptr Widget) -> IO (Ptr ComboBoxEntry)
forall a b. (a -> b) -> a -> b
$
  IO (Ptr Widget)
gtk_combo_box_entry_new
{-# LINE 124 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}

-- | Creates a new 'ComboBoxEntry' with a store containing strings.
-- See 'comboBoxEntrySetModelText'.
--
comboBoxEntryNewText :: IO ComboBoxEntry
comboBoxEntryNewText :: IO ComboBoxEntry
comboBoxEntryNewText = do
  ComboBoxEntry
combo <- IO ComboBoxEntry
comboBoxEntryNew
  ComboBoxEntry -> IO (ListStore String)
forall self.
ComboBoxEntryClass self =>
self -> IO (ListStore String)
comboBoxEntrySetModelText ComboBoxEntry
combo
  ComboBoxEntry -> IO ComboBoxEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ComboBoxEntry
combo

-- | Creates a new 'ComboBoxEntry' which has a 'Entry' as child and a list of
-- strings as popup. You can get the 'Entry' from a 'ComboBoxEntry' using
-- 'binGetChild'. To add and remove strings from the list, just modify @model@
-- using its data manipulation API.
--
comboBoxEntryNewWithModel :: TreeModelClass model =>
    model -- ^ @model@ - A 'CustomStore'.
 -> IO ComboBoxEntry
comboBoxEntryNewWithModel :: forall model. TreeModelClass model => model -> IO ComboBoxEntry
comboBoxEntryNewWithModel model
model = do
  ComboBoxEntry
combo <- IO ComboBoxEntry
comboBoxEntryNew
  ComboBoxEntry -> Maybe model -> IO ()
forall self model.
(ComboBoxClass self, TreeModelClass model) =>
self -> Maybe model -> IO ()
comboBoxSetModel ComboBoxEntry
combo (model -> Maybe model
forall a. a -> Maybe a
Just model
model)
  ComboBoxEntry -> IO ComboBoxEntry
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ComboBoxEntry
combo

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

-- | Set a model that holds strings.
--
-- This function stores a 'Graphics.UI.Gtk.ModelView.ListStore' with the
-- widget and sets the model to the list store. The widget can contain only
-- strings. The model can be retrieved with 'comboBoxGetModel'. The list
-- store can be retrieved with 'comboBoxGetModelText'.
-- Any exisiting model or renderers are removed before setting the new text
-- model.
-- In order to respond to new texts that the user enters, it is necessary to
-- connect to the 'Graphics.UI.Gtk.Entry.Entry.entryActivated' signal of the
-- contained 'Graphics.UI.Gtk.Entry.Entry.Entry' and insert the text into the
-- text model which can be retrieved with
-- 'Graphics.UI.Gtk.MenuComboToolbar.ComboBox.comboBoxGetModelText'.
-- Note that the functions 'comboBoxAppendText', 'comboBoxInsertText',
-- 'comboBoxPrependText', 'comboBoxRemoveText' and 'comboBoxGetActiveText'
-- can be called on a combo box only once 'comboBoxEntrySetModelText' is
-- called.
--
comboBoxEntrySetModelText :: ComboBoxEntryClass self => self ->
                             IO (ListStore String)
comboBoxEntrySetModelText :: forall self.
ComboBoxEntryClass self =>
self -> IO (ListStore String)
comboBoxEntrySetModelText self
combo = do
  ListStore String
store <- [String] -> IO (ListStore String)
forall a. [a] -> IO (ListStore a)
listStoreNew ([] :: [String])
  self -> Maybe (ListStore String) -> IO ()
forall self model.
(ComboBoxClass self, TreeModelClass model) =>
self -> Maybe model -> IO ()
comboBoxSetModel self
combo (ListStore String -> Maybe (ListStore String)
forall a. a -> Maybe a
Just ListStore String
store)
  let colId :: ColumnId row String
colId = Int -> ColumnId row String
forall string row. GlibString string => Int -> ColumnId row string
makeColumnIdString Int
0
  ListStore String
-> ColumnId String String -> (String -> String) -> IO ()
forall (model :: * -> *) row ty.
TypedTreeModelClass model =>
model row -> ColumnId row ty -> (row -> ty) -> IO ()
customStoreSetColumn ListStore String
store ColumnId String String
forall {row}. ColumnId row String
colId String -> String
forall a. a -> a
id
  ComboBoxEntry -> ColumnId Any String -> IO ()
forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> ColumnId row string -> IO ()
comboBoxEntrySetTextColumn (self -> ComboBoxEntry
forall o. ComboBoxEntryClass o => o -> ComboBoxEntry
toComboBoxEntry self
combo) ColumnId Any String
forall {row}. ColumnId row String
colId
  Quark -> ComboBoxEntry -> Maybe (ListStore String) -> IO ()
forall o a. GObjectClass o => Quark -> o -> Maybe a -> IO ()
objectSetAttribute Quark
comboQuark (self -> ComboBoxEntry
forall o. ComboBoxEntryClass o => o -> ComboBoxEntry
toComboBoxEntry self
combo) (ListStore String -> Maybe (ListStore String)
forall a. a -> Maybe a
Just ListStore String
store)
  ListStore String -> IO (ListStore String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ListStore String
store

-- %hash c:b7d7 d:2818
-- | Sets the model column should be use to get strings from to
-- be @textColumn@.
--
comboBoxEntrySetTextColumn :: (ComboBoxEntryClass self, GlibString string) => self
 -> ColumnId row string -- ^ @textColumn@ - A column in @model@ to get the strings from.
 -> IO ()
comboBoxEntrySetTextColumn :: forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> ColumnId row string -> IO ()
comboBoxEntrySetTextColumn self
self ColumnId row string
textColumn =
  (\(ComboBoxEntry ForeignPtr ComboBoxEntry
arg1) CInt
arg2 -> ForeignPtr ComboBoxEntry -> (Ptr ComboBoxEntry -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ComboBoxEntry
arg1 ((Ptr ComboBoxEntry -> IO ()) -> IO ())
-> (Ptr ComboBoxEntry -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr ComboBoxEntry
argPtr1 ->Ptr ComboBoxEntry -> CInt -> IO ()
gtk_combo_box_entry_set_text_column Ptr ComboBoxEntry
argPtr1 CInt
arg2)
{-# LINE 188 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
    (toComboBoxEntry self)
    (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ColumnId row string -> Int
forall row ty. ColumnId row ty -> Int
columnIdToNumber ColumnId row string
textColumn))

-- %hash c:a3e3 d:6441
-- | Returns the column which is used to get the strings from.
--
comboBoxEntryGetTextColumn :: (ComboBoxEntryClass self, GlibString string) => self
 -> IO (ColumnId row string) -- ^ returns A column in the data source model of @entryBox@.
comboBoxEntryGetTextColumn :: forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> IO (ColumnId row string)
comboBoxEntryGetTextColumn self
self =
  (CInt -> ColumnId row string)
-> IO CInt -> IO (ColumnId row string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (Int -> ColumnId row string
forall string row. GlibString string => Int -> ColumnId row string
makeColumnIdString (Int -> ColumnId row string)
-> (CInt -> Int) -> CInt -> ColumnId row string
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) (IO CInt -> IO (ColumnId row string))
-> IO CInt -> IO (ColumnId row string)
forall a b. (a -> b) -> a -> b
$
  (\(ComboBoxEntry ForeignPtr ComboBoxEntry
arg1) -> ForeignPtr ComboBoxEntry
-> (Ptr ComboBoxEntry -> IO CInt) -> IO CInt
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ComboBoxEntry
arg1 ((Ptr ComboBoxEntry -> IO CInt) -> IO CInt)
-> (Ptr ComboBoxEntry -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ \Ptr ComboBoxEntry
argPtr1 ->Ptr ComboBoxEntry -> IO CInt
gtk_combo_box_entry_get_text_column Ptr ComboBoxEntry
argPtr1)
{-# LINE 199 "./Graphics/UI/Gtk/MenuComboToolbar/ComboBoxEntry.chs" #-}
    (toComboBoxEntry self)


-- | Retrieve the text currently in the entry.
--
-- * Returns @Nothing@ if no text is selected or entered.
--
-- * Availabe in Gtk 2.6 or higher.
--
comboBoxEntryGetActiveText :: (ComboBoxEntryClass self, GlibString string) => self
  -> IO (Maybe string)
comboBoxEntryGetActiveText :: forall self string.
(ComboBoxEntryClass self, GlibString string) =>
self -> IO (Maybe string)
comboBoxEntryGetActiveText self
self = do
  Ptr CChar
strPtr <- (\(ComboBox ForeignPtr ComboBox
arg1) -> ForeignPtr ComboBox
-> (Ptr ComboBox -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ComboBox
arg1 ((Ptr ComboBox -> IO (Ptr CChar)) -> IO (Ptr CChar))
-> (Ptr ComboBox -> IO (Ptr CChar)) -> IO (Ptr CChar)
forall a b. (a -> b) -> a -> b
$ \Ptr ComboBox
argPtr1 ->Ptr ComboBox -> IO (Ptr CChar)
gtk_combo_box_get_active_text Ptr ComboBox
argPtr1) (self -> ComboBox
forall o. ComboBoxClass o => o -> ComboBox
toComboBox self
self)
  if Ptr CChar
strPtr Ptr CChar -> Ptr CChar -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr CChar
forall a. Ptr a
nullPtr then Maybe string -> IO (Maybe string)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe string
forall a. Maybe a
Nothing else (string -> Maybe string) -> IO string -> IO (Maybe string)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM string -> Maybe string
forall a. a -> Maybe a
Just (IO string -> IO (Maybe string)) -> IO string -> IO (Maybe string)
forall a b. (a -> b) -> a -> b
$
    Ptr CChar -> IO string
forall s. GlibString s => Ptr CChar -> IO s
peekUTFString (Ptr CChar -> Ptr CChar
forall a b. Ptr a -> Ptr b
castPtr Ptr CChar
strPtr)


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

-- %hash c:84ff d:be07
-- | A column in the data source model to get the strings from.
--
-- Allowed values: >= 0
--
-- Default value: 'Graphics.UI.Gtk.ModelView.CustomStore.invalidColumnId'
--
comboBoxEntryTextColumn :: (ComboBoxEntryClass self, GlibString string) => Attr self (ColumnId row string)
comboBoxEntryTextColumn :: forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
Attr self (ColumnId row string)
comboBoxEntryTextColumn = (self -> IO (ColumnId row string))
-> (self -> ColumnId row string -> IO ())
-> ReadWriteAttr self (ColumnId row string) (ColumnId row string)
forall o a b.
(o -> IO a) -> (o -> b -> IO ()) -> ReadWriteAttr o a b
newAttr
  self -> IO (ColumnId row string)
forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> IO (ColumnId row string)
comboBoxEntryGetTextColumn
  self -> ColumnId row string -> IO ()
forall self string row.
(ComboBoxEntryClass self, GlibString string) =>
self -> ColumnId row string -> IO ()
comboBoxEntrySetTextColumn

foreign import ccall safe "gtk_combo_box_entry_new"
  gtk_combo_box_entry_new :: (IO (Ptr Widget))

foreign import ccall safe "gtk_combo_box_entry_set_text_column"
  gtk_combo_box_entry_set_text_column :: ((Ptr ComboBoxEntry) -> (CInt -> (IO ())))

foreign import ccall safe "gtk_combo_box_entry_get_text_column"
  gtk_combo_box_entry_get_text_column :: ((Ptr ComboBoxEntry) -> (IO CInt))

foreign import ccall safe "gtk_combo_box_get_active_text"
  gtk_combo_box_get_active_text :: ((Ptr ComboBox) -> (IO (Ptr CChar)))