module Graphics.UI.Gtk.Entry.FormatEntry
( FormatEntry
, formatEntryNew
, formatEntryNewWithFunction
, formatEntrySetColor
, formatEntryGetColor
, formatEntrySetCheckFunction
, formatEntryGetCheckFunction
, formatEntryHasCorrectFormat
, formatEntryColor
, formatEntryCheckFunction
)
where
import Control.Monad.Trans (liftIO)
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Entry.HighlightedEntry
import System.Glib.Types
import Data.IORef
data FormatEntry = FormatEntry HighlightedEntry (IORef FormatEntryParams)
type FormatEntryParams = String -> Bool
formatEntryNew :: IO FormatEntry
formatEntryNew = formatEntryNewWithFunction (const True)
formatEntryNewWithFunction :: (String -> Bool) -> IO FormatEntry
formatEntryNewWithFunction checkF = do
entry <- highlightedEntryNew
defaultParamsRef <- newIORef checkF
let formatEntry = FormatEntry entry defaultParamsRef
formatEntry `on` editableChanged $ refreshEntry formatEntry
return formatEntry
instance GObjectClass FormatEntry where
toGObject (FormatEntry entry _) = toGObject entry
unsafeCastGObject o = FormatEntry (unsafeCastGObject o) undefined
instance ObjectClass FormatEntry
instance WidgetClass FormatEntry
instance EntryClass FormatEntry
instance EditableClass FormatEntry
formatEntrySetColor :: FormatEntry -> Color -> IO ()
formatEntrySetColor (FormatEntry e _) color = highlightedEntrySetColor e color
formatEntryGetColor :: FormatEntry -> IO Color
formatEntryGetColor (FormatEntry e _) = highlightedEntryGetColor e
formatEntrySetCheckFunction :: FormatEntry -> (String -> Bool) -> IO ()
formatEntrySetCheckFunction fe@(FormatEntry _ params) checkF = do
writeIORef params checkF
refreshEntry fe
formatEntryGetCheckFunction :: FormatEntry -> IO (String -> Bool)
formatEntryGetCheckFunction (FormatEntry _ params) =
readIORef params
refreshEntry :: FormatEntry -> IO()
refreshEntry f@(FormatEntry entry params) = do
correct <- formatEntryHasCorrectFormat f
highlightedEntrySetStatus entry (not correct)
formatEntryColor :: Attr FormatEntry Color
formatEntryColor = newAttr formatEntryGetColor formatEntrySetColor
formatEntryCheckFunction :: Attr FormatEntry (String -> Bool)
formatEntryCheckFunction = newAttr formatEntryGetCheckFunction formatEntrySetCheckFunction
formatEntryHasCorrectFormat :: FormatEntry -> IO Bool
formatEntryHasCorrectFormat f = do
text <- entryGetText f
func <- formatEntryGetCheckFunction f
return $ func text