    {-# OPTIONS_GHC -XScopedTypeVariables #-}
    -----------------------------------------------------------------------------
    --
    -- Module      :  Graphics.UI.Editor.Simple
    -- Copyright   :  (c) Juergen Nicklisch-Franken, Hamish Mackenzie
    -- License     :  GNU-GPL
    --
    -- Maintainer  :  <maintainer at leksah.org>
    -- Stability   :  provisional
    -- Portability :  portable
    --
    -- | Module for making simple editors
    --
    -----------------------------------------------------------------------------------

    module Graphics.UI.Editor.Simple (
        noEditor
    ,   boolEditor
    ,   boolEditor2
    ,   enumEditor
    ,   clickEditor
    ,   stringEditor
    ,   multilineStringEditor
    ,   intEditor
    ,   genericEditor
    ,   fontEditor
    ,   colorEditor
    ,   comboSelectionEditor
    ,   staticListEditor
    ,   staticListMultiEditor
    ,   multiselectionEditor
    ,   fileEditor
    ,   otherEditor
    ,   imageEditor

    ,   okCancelFields
    ) where

    #if MIN_VERSION_gtk(0,10,5)
    import Graphics.UI.Gtk hiding (eventKeyName, eventModifier)
    #else
    import Graphics.UI.Gtk
    #endif
    import qualified Graphics.UI.Gtk as Gtk
    import Control.Monad
    import Data.IORef
    import Data.List
    import Data.Maybe
    import System.FilePath.Posix

    import Graphics.UI.Editor.Parameters
    --import Graphics.UI.Editor.Basics
    import Graphics.UI.Editor.MakeEditor
    import Control.Event
    #if MIN_VERSION_gtk(0,10,5)
    import Graphics.UI.Gtk.Gdk.Events (Event(..))
    #else
    import Graphics.UI.Gtk.Gdk.Events (Event(..))
    #endif
    import MyMissing (trim, allOf)
    import qualified Graphics.UI.Gtk.Gdk.Events as Gtk (Event(..))
    import Unsafe.Coerce (unsafeCoerce)
    import Graphics.UI.Editor.Basics
           (GUIEvent(..), GUIEventSelector(..), propagateAsChanged,
            genericGUIEvents, activateEvent, Editor)
    import Control.Exception (catch, IOException)

    -- ------------------------------------------------------------
    -- * Simple Editors
    -- ------------------------------------------------------------

    instance ContainerClass Widget
    instance BinClass Widget
    instance ButtonClass Widget

    --
    -- | An invisible editor without any effect
    --
    noEditor :: alpha -> Editor alpha
    noEditor proto parameters notifier =
        mkEditor
            (\ widget _ -> return ())
            (return (Just proto))
            parameters
            notifier

    --
    -- | Editor for a boolean value in the form of a check button
    --
    boolEditor :: Editor Bool
    boolEditor parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget bool -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        button <- checkButtonNewWithLabel (getParameter paraName parameters)
                        widgetSetName button (getParameter paraName parameters)
                        containerAdd widget button
                        toggleButtonSetActive button bool
                        mapM_ (activateEvent (castToWidget button) notifier Nothing)
                            (Clicked: genericGUIEvents)
                        propagateAsChanged notifier [Clicked]
                        writeIORef coreRef (Just button)
                    Just button -> toggleButtonSetActive button bool)
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just button -> do
                        r <- toggleButtonGetActive button
                        return (Just r))
            (paraName <<<- ParaName "" $ parameters)
            notifier

    --
    -- | Editor for a boolean value in the form of two radio buttons
    ----
    boolEditor2 :: String -> Editor Bool
    boolEditor2 label2 parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget bool -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        box <- vBoxNew True 2
                        radio1 <- radioButtonNewWithLabel (getParameter paraName parameters)
                        radio2 <- radioButtonNewWithLabelFromWidget radio1 label2
                        boxPackStart box radio1 PackGrow 2
                        boxPackStart box radio2 PackGrow 2
                        widgetSetName radio1 $ getParameter paraName parameters ++ ".1"
                        widgetSetName radio2 $ getParameter paraName parameters ++ ".2"
                        containerAdd widget box
                        if bool
                            then toggleButtonSetActive radio1 True
                            else toggleButtonSetActive radio2 True
                        mapM_ (activateEvent (castToWidget radio1) notifier Nothing) (Clicked:genericGUIEvents)
                        mapM_ (activateEvent (castToWidget radio2) notifier Nothing) (Clicked:genericGUIEvents)
                        propagateAsChanged notifier [Clicked]
                        writeIORef coreRef (Just (radio1,radio2))
                    Just (radio1,radio2) ->
                        if bool
                            then toggleButtonSetActive radio1 True
                            else toggleButtonSetActive radio2 True)
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just (radio1,radio2) -> do
                        r <- toggleButtonGetActive radio1
                        return (Just r))
            (paraName <<<- ParaName "" $ parameters)
            notifier

    --
    -- | Editor for an enum value in the form of n radio buttons
    ----
    enumEditor :: forall alpha . (Show alpha, Enum alpha, Bounded alpha)  => [String] -> Editor alpha
    enumEditor labels parameters notifier = do
        coreRef <- newIORef Nothing
        let vals :: [alpha] =  allOf
        mkEditor
            (\widget enumValue -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        box <- vBoxNew True 2
                        let label0 = if length labels > 0 then labels !! 0 else show (vals !! 0)
                        button0 <- radioButtonNewWithLabel label0
                        buttons <- mapM (\ v -> do
                            let n = fromEnum v
                            let label = if length labels > n then labels !! n else show v
                            radio <- if n == 0
                                        then return button0
                                        else radioButtonNewWithLabelFromWidget button0 label
                            boxPackStart box radio PackGrow 2
                            widgetSetName radio (label ++ show n)
                            return radio) vals
                        containerAdd widget box
                        mapM_
                            (\e ->
                                (mapM_
                                    (\b -> activateEvent (castToWidget b) notifier Nothing e)
                                 buttons)) (Clicked:genericGUIEvents)
                        propagateAsChanged notifier [Clicked]
                        mapM_ (\(b,n) -> toggleButtonSetActive b (n == fromEnum enumValue))
                                    (zip buttons [0..length buttons - 1])
                        writeIORef coreRef (Just buttons)
                    Just buttons -> do
                        mapM_ (\(b,n) -> toggleButtonSetActive b (n == fromEnum enumValue))
                                    (zip buttons [0..length buttons - 1]))
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just buttons -> do
                        boolArray <- mapM toggleButtonGetActive buttons
                        let mbInd =  findIndex (== True) boolArray
                        let res = case mbInd of
                                    Nothing -> Nothing
                                    Just i -> Just (vals !! i)
                        return res)
            (paraName <<<- ParaName "" $ parameters)
            notifier

    -- | An Editor for nothing (which may report a click) in the form of a button
    --
    clickEditor :: Bool -> Editor ()
    clickEditor canDefault parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget bool -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        button <- case getParameter paraStockId parameters of
                            "" ->   buttonNewWithLabel (getParameter paraName parameters)
                            st ->   buttonNewFromStock st
                        widgetSetName button (getParameter paraName parameters)
                        containerAdd widget button
                        activateEvent (castToWidget button) notifier Nothing Clicked
                        writeIORef coreRef (Just button)
                        when canDefault $ do
                            set button [widgetCanDefault := True]
                            widgetGrabDefault button
                    Just button -> return ())
            (return (Just ()))
            (paraName <<<- ParaName "" $ parameters)
            notifier

    -- | An Editor to display an image
    --
    imageEditor :: Editor StockId
    imageEditor parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget stockId -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        image <- imageNewFromStock stockId IconSizeLargeToolbar
                        widgetSetName image (getParameter paraName parameters)
                        containerAdd widget image
                        writeIORef coreRef (Just (image,stockId))
                    Just (image,stockId2) -> imageSetFromStock image stockId IconSizeLargeToolbar)
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just (_,stockId3) -> return (Just stockId3))
            parameters
            notifier

    --
    -- | Editor for a string in the form of a text entry
    --
    stringEditor :: (String -> Bool) -> Bool -> Editor String
    stringEditor validation trimBlanks parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget string -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        entry   <-  entryNew
                        widgetSetName entry (getParameter paraName parameters)
                        mapM_ (activateEvent (castToWidget entry) notifier Nothing) genericGUIEvents
                        propagateAsChanged notifier [KeyPressed]
                        containerAdd widget entry
                        entrySetText entry (if trimBlanks then trim string else string)
                        writeIORef coreRef (Just entry)
                    Just entry -> entrySetText entry (if trimBlanks then trim string else string))
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just entry -> do
                        r <- entryGetText entry
                        if validation r
                            then return (Just (if trimBlanks then trim r else r))
                            else return Nothing)
            parameters
            notifier

    --
    -- | Editor for a multiline string in the form of a multiline text entry
    --
    multilineStringEditor :: Editor String
    multilineStringEditor parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget string -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        aTextView       <-  textViewNew
                        widgetSetName aTextView (getParameter paraName parameters)
                        aScrolledWindow <-  scrolledWindowNew Nothing Nothing
                        scrolledWindowSetPolicy aScrolledWindow PolicyAutomatic PolicyAutomatic
                        containerAdd aScrolledWindow aTextView
                        containerAdd widget aScrolledWindow
                        mapM_ (activateEvent (castToWidget aTextView) notifier Nothing) genericGUIEvents
                        propagateAsChanged notifier [KeyPressed]
                        buffer          <-  textViewGetBuffer aTextView
                        textBufferSetText buffer string
                        writeIORef coreRef (Just (aScrolledWindow,aTextView))
                    Just (aScrolledWindow,aTextView) -> do
                        buffer          <-  textViewGetBuffer aTextView
                        textBufferSetText buffer string)
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just (aScrolledWindow, aTextView) -> do
                        buffer          <-  textViewGetBuffer aTextView
                        start           <-  textBufferGetStartIter buffer
                        end             <-  textBufferGetEndIter buffer
                        r               <-  textBufferGetText buffer start end False
                        return (Just r))
            parameters
            notifier

    --
    -- | Editor for an integer in the form of a spin entry
    --
    intEditor :: (Double,Double,Double) -> Editor Int
    intEditor (min, max, step) parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget v -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        spin <- spinButtonNewWithRange min max step
                        widgetSetName spin (getParameter paraName parameters)
                        mapM_ (activateEvent (castToWidget spin) notifier Nothing) (genericGUIEvents)
                        activateEvent (castToWidget spin) notifier
                            (Just (\ w h -> do
                                res     <-  afterValueSpinned (castToSpinButton w) (do
                                    h (Gtk.Event True)
                                    return ())
                                return (unsafeCoerce res))) MayHaveChanged
                        containerAdd widget spin
                        spinButtonSetValue spin (fromIntegral v)
                        writeIORef coreRef (Just spin)
                    Just spin -> spinButtonSetValue spin (fromIntegral v))
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just spin -> do
                        newNum <- spinButtonGetValue spin
                        return (Just (truncate newNum)))
            parameters
            notifier

    --
    -- | Editor for for any value which is an instance of Read and Show in the form of a
    -- | text entry
    genericEditor :: (Show beta, Read beta) => Editor beta
    genericEditor parameters notifier = do
        (wid,inj,ext) <- stringEditor (const True) True parameters notifier
        let ginj = inj . show
        let gext = do
            s <- ext
            case s of
                Nothing -> return Nothing
                Just s -> catch (liftM Just (readIO s))
                                (\ (e :: IOException) -> do
                                    putStrLn ("Generic editor no parse for " ++ s ++ " " ++ show e)
                                    return Nothing)
        return (wid,ginj,gext)

    --
    -- | Editor for no value, it only emtis a clicked event and has the form of a check button
    --
    buttonEditor :: Editor ()
    buttonEditor parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget _ -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        button <- buttonNewWithLabel (getParameter paraName parameters)
                        widgetSetName button (getParameter paraName parameters)
                        containerAdd widget button
                        mapM_ (activateEvent (castToWidget button) notifier Nothing) (Clicked:genericGUIEvents)
                        writeIORef coreRef (Just button)
                    Just button -> return ())
            (return (Just ()))
            parameters
            notifier

    --
    -- | Editor for the selection of some element from a static list of elements in the
    -- | form of a combo box

    comboSelectionEditor :: Eq beta => [beta] -> (beta -> String) -> Editor beta
    comboSelectionEditor list showF parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget obj -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        combo <- comboBoxNewText
                        mapM_ (\o -> comboBoxAppendText combo (showF o)) list
                        widgetSetName combo (getParameter paraName parameters)
                        mapM_ (activateEvent (castToWidget combo) notifier Nothing) genericGUIEvents
                        activateEvent (castToWidget combo) notifier
                            (Just (\ w h -> do
                                res     <-  on (castToComboBox w) changed (do
                                    h (Gtk.Event True)
                                    return ())
                                return (unsafeCoerce res))) MayHaveChanged
                        comboBoxSetActive combo 1
                        containerAdd widget combo
                        let ind = elemIndex obj list
                        case ind of
                            Just i -> comboBoxSetActive combo i
                            Nothing -> return ()
                        writeIORef coreRef (Just combo)
                    Just combo -> do
                        let ind = elemIndex obj list
                        case ind of
                            Just i -> comboBoxSetActive combo i
                            Nothing -> return ())
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just combo -> do
                        ind <- comboBoxGetActive combo
                        case ind of
                            (-1)   -> return Nothing
                            otherwise  -> return (Just (list !! ind)))
            parameters
            notifier

    --
    -- | Editor for the selection of some elements from a list of elements in the
    -- | form of a list box
    multiselectionEditor :: (Show beta, Eq beta) => Editor [beta]
    multiselectionEditor parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget objs -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        listStore   <- listStoreNew ([]:: [alpha])
                        listView    <- treeViewNewWithModel listStore
                        widgetSetName listView (getParameter paraName parameters)
                        mapM_ (activateEvent (castToWidget listView) notifier Nothing) genericGUIEvents
                        propagateAsChanged notifier [KeyPressed,ButtonPressed]
                        sel         <- treeViewGetSelection listView
                        treeSelectionSetMode sel SelectionMultiple
                        renderer    <- cellRendererTextNew
                        col         <- treeViewColumnNew
                        treeViewAppendColumn listView col
                        cellLayoutPackStart col renderer True
                        cellLayoutSetAttributes col renderer listStore
                            $ \row -> [ cellText := show row ]
                        treeViewSetHeadersVisible listView False
                        listStoreClear listStore
                        mapM_ (listStoreAppend listStore) objs
                        containerAdd widget listView
                        treeSelectionUnselectAll sel
                        --let inds = catMaybes $map (\obj -> elemIndex obj list) objs
                        --mapM_ (\i -> treeSelectionSelectPath sel [i]) inds
                        writeIORef coreRef (Just (listView,listStore))
                    Just (listView,listStore) -> do
                        listStoreClear listStore
                        mapM_ (listStoreAppend listStore) objs)
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just (listView,listStore) -> do
                        sel         <- treeViewGetSelection listView
                        treePath    <- treeSelectionGetSelectedRows sel
                        values      <- mapM (\[i] -> listStoreGetValue listStore i) treePath
                        return (Just values))
            parameters
            notifier

    --
    -- | Editor for the selection of some elements from a static list of elements in the
    -- | form of a list box with toggle elements

    staticListMultiEditor :: (Eq beta) => [beta] -> (beta -> String) -> Editor [beta]
    staticListMultiEditor list showF parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget objs -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        listStore <- listStoreNew ([]:: [(Bool,beta)])
                        listView <- treeViewNewWithModel listStore
                        widgetSetName listView (getParameter paraName parameters)
                        mapM_ (activateEvent (castToWidget listView) notifier Nothing) genericGUIEvents
                        propagateAsChanged notifier [KeyPressed,ButtonPressed]
                        sel <- treeViewGetSelection listView
                        treeSelectionSetMode sel SelectionSingle
                        rendererToggle <- cellRendererToggleNew
                        set rendererToggle [cellToggleActivatable := True]
                        rendererText <- cellRendererTextNew
                        col1 <- treeViewColumnNew
                        treeViewAppendColumn listView col1
                        cellLayoutPackStart col1 rendererToggle True
                        cellLayoutSetAttributes col1 rendererToggle listStore
                            $ \row -> [ cellToggleActive := fst row]
                        col2 <- treeViewColumnNew
                        treeViewAppendColumn listView col2
                        cellLayoutPackStart col2 rendererText True
                        cellLayoutSetAttributes col2 rendererText listStore
                            $ \row -> [ cellText := showF (snd row)]
                        treeViewSetHeadersVisible listView False
                        listStoreClear listStore
                        mapM_ (listStoreAppend listStore) $ map (\e -> (elem e objs,e)) list
                        let minSize =   getParameter paraMinSize parameters
                        uncurry (widgetSetSizeRequest listView) minSize
                        sw          <-  scrolledWindowNew Nothing Nothing
                        containerAdd sw listView
                        scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
                        containerAdd widget sw
                          -- update the model when the toggle buttons are activated
                        on rendererToggle cellToggled $ \pathStr -> do
                            let (i:_) = stringToTreePath pathStr
                            val <- listStoreGetValue listStore i
                            listStoreSetValue listStore i (not (fst val),snd val)
                        listView `onKeyPress` (\event -> do
                            let Key { eventKeyName = name, eventModifier = modifier, eventKeyChar = char } = event
                            case (name, modifier, char) of
                                ("Return", _, _) -> do
                                    sel <- treeViewGetSelection listView
                                    rows <- treeSelectionGetSelectedRows sel
                                    mapM_ (\ (i:_) -> do
                                        val <- listStoreGetValue listStore i
                                        listStoreSetValue listStore i (not (fst val),snd val)) rows
                                    return True
                                _ -> return False)
                        writeIORef coreRef (Just (listView,listStore))
                    Just (listView,listStore) -> do
                        let model = map (\e -> (elem e objs,e)) list
                        listStoreClear listStore
                        mapM_ (listStoreAppend listStore) $ map (\e -> (elem e objs,e)) list)
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just (listView,listStore) -> do
                        model <- listStoreToList listStore
                        return (Just (map snd $ filter (\e -> fst e) model)))
            parameters
            notifier

    --
    -- | Editor for the selection of some elements from a static list of elements in the
    -- | form of a list box

    staticListEditor :: (Eq beta) => [beta] -> (beta -> String) -> Editor beta
    staticListEditor list showF parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget obj -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        listStore <- listStoreNew ([]:: [alpha])
                        listView <- treeViewNewWithModel listStore
                        widgetSetName listView (getParameter paraName parameters)
                        mapM_ (activateEvent (castToWidget listView) notifier Nothing) genericGUIEvents
                        propagateAsChanged notifier [KeyPressed,ButtonPressed]
                        sel <- treeViewGetSelection listView
                        treeSelectionSetMode sel
                            (case getParameter paraMultiSel parameters of
                                True  -> SelectionMultiple
                                False -> SelectionSingle)
                        renderer <- cellRendererTextNew
                        col <- treeViewColumnNew
                        treeViewAppendColumn listView col
                        cellLayoutPackStart col renderer True
                        cellLayoutSetAttributes col renderer listStore
                            $ \row -> [ cellText := showF row ]
                        treeViewSetHeadersVisible listView False
                        listStoreClear listStore
                        mapM_ (listStoreAppend listStore) list
                        let minSize =   getParameter paraMinSize parameters
                        uncurry (widgetSetSizeRequest listView) minSize
                        sw          <-  scrolledWindowNew Nothing Nothing
                        containerAdd sw listView
                        scrolledWindowSetPolicy sw PolicyAutomatic PolicyAutomatic
                        containerAdd widget sw
                        treeSelectionUnselectAll sel
                        let mbInd = elemIndex obj list
                        case mbInd of
                            Nothing -> return ()
                            Just ind -> treeSelectionSelectPath sel [ind]
                        writeIORef coreRef (Just listView)
                    Just listView -> do
                        sel <- treeViewGetSelection listView
                        treeSelectionUnselectAll sel
                        let mbInd = elemIndex obj list
                        case mbInd of
                            Nothing -> return ()
                            Just ind -> treeSelectionSelectPath sel [ind])
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just listView -> do
                        sel <- treeViewGetSelection listView
                        treePaths <- treeSelectionGetSelectedRows sel
                        case treePaths of
                            [[i]] -> return (Just (list !! i))
                            _ -> return Nothing)
            parameters
            notifier

    --
    -- | Editor for the selection of a file path in the form of a text entry and a button,
    -- | which opens a gtk file chooser
    fileEditor :: Maybe FilePath -> FileChooserAction -> String -> Editor FilePath
    fileEditor mbFilePath action buttonName parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget filePath -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        button <- buttonNewWithLabel buttonName
                        widgetSetName button $ getParameter paraName parameters ++ "-button"
                        mapM_ (activateEvent (castToWidget button) notifier Nothing)
                            (Clicked:genericGUIEvents)
                        entry   <-  entryNew
                        widgetSetName entry $ getParameter paraName parameters ++ "-entry"
                        -- set entry [ entryEditable := False ]
                        mapM_ (activateEvent (castToWidget entry) notifier Nothing) genericGUIEvents
                        registerEvent notifier Clicked (buttonHandler entry)
                        propagateAsChanged notifier [KeyPressed,ButtonPressed]
                        box <- case getParameter paraDirection parameters of
                                    Horizontal  -> do
                                        r <- hBoxNew False 1
                                        return (castToBox r)
                                    Vertical    -> do
                                        r <- vBoxNew False 1
                                        return (castToBox r)
                        boxPackStart box entry PackGrow 0
                        boxPackEnd box button PackNatural 0
                        containerAdd widget box
                        entrySetText entry filePath
                        writeIORef coreRef (Just entry)
                    Just entry -> entrySetText entry filePath)
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just entry -> do
                        str <- entryGetText entry
                        return (Just str))
            parameters
            notifier
        where
        buttonHandler entry e =  do
            mbFileName <- do
                dialog <- fileChooserDialogNew
                                (Just "Select File")
                                Nothing
                            action
                            [("gtk-cancel"
                            ,ResponseCancel)
                            ,("gtk-open"
                            ,ResponseAccept)]
                widgetShow dialog
                response <- dialogRun dialog
                case response of
                    ResponseAccept -> do
                        f <- fileChooserGetFilename dialog
                        widgetDestroy dialog
                        return f
                    ResponseCancel -> do
                        widgetDestroy dialog
                        return Nothing
                    ResponseDeleteEvent-> do
                        widgetDestroy dialog
                        return Nothing
                    _   -> return Nothing
            case mbFileName of
                Nothing -> return (e{gtkReturn=True})
                Just fn -> do
    --                let relative = case mbFilePath of
    --                                Nothing -> fn
    --                                Just rel -> makeRelative rel fn
                    entrySetText entry fn
                    triggerEvent notifier (GUIEvent {
                        selector = MayHaveChanged,
                        gtkEvent = Gtk.Event True,
                        eventText = "",
                        gtkReturn = True})
                    return (e{gtkReturn=True})

    --
    -- | Editor for a font selection
    --
    fontEditor :: Editor (Maybe String)
    fontEditor parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget mbValue -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        fs <- fontButtonNew
                        widgetSetName fs $ getParameter paraName parameters
                        mapM_ (activateEvent (castToWidget fs) notifier Nothing) (Clicked: genericGUIEvents)
                        activateEvent (castToWidget fs) notifier
                            (Just (\ w h -> do
                                res     <-  onFontSet (castToFontButton w)  (do
                                    h (Gtk.Event True)
                                    return ())
                                return (unsafeCoerce res))) MayHaveChanged
                        containerAdd widget fs
                        case mbValue of
                            Nothing -> return True
                            Just s  -> fontButtonSetFontName fs s
                        writeIORef coreRef (Just fs)
                    Just fs ->   case mbValue of
                                    Nothing -> return ()
                                    Just s  -> do
                                        fontButtonSetFontName fs s
                                        return ())
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just fs -> do
                        f <- fontButtonGetFontName fs
                        return (Just (Just f)))
            parameters
            notifier

    --
    -- | Editor for color selection
    --
    colorEditor :: Editor Color
    colorEditor parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget c -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        cs <- colorButtonNew
                        widgetSetName cs $ getParameter paraName parameters
                        mapM_ (activateEvent (castToWidget cs) notifier Nothing) (Clicked: genericGUIEvents)
                        activateEvent (castToWidget cs) notifier
                            (Just (\ w h -> do
                                res     <-  onColorSet (castToColorButton w)  (do
                                    h (Gtk.Event True)
                                    return ())
                                return (unsafeCoerce res))) MayHaveChanged
                        containerAdd widget cs
                        colorButtonSetColor cs c
                        writeIORef coreRef (Just cs)
                    Just cs -> colorButtonSetColor cs c)
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just cs -> do
                        c <- colorButtonGetColor cs
                        return (Just c))
            parameters
            notifier

    --
    -- | An editor, which opens another editor
    --   You have to inject a value before the button can be clicked.
    --
    otherEditor :: (alpha  -> String -> IO (Maybe alpha)) -> Editor alpha
    otherEditor func parameters notifier = do
        coreRef <- newIORef Nothing
        mkEditor
            (\widget val -> do
                core <- readIORef coreRef
                case core of
                    Nothing  -> do
                        button <- buttonNewWithLabel (getParameter paraName parameters)
                        widgetSetName button $ getParameter paraName parameters
                        containerAdd widget button
                        mapM_ (activateEvent (castToWidget button) notifier Nothing) (Clicked:genericGUIEvents)
                        registerEvent notifier Clicked (buttonHandler coreRef)
                        propagateAsChanged notifier [KeyPressed,ButtonPressed,Clicked]
                        writeIORef coreRef (Just (button,val))
                    Just (button, oldval) -> writeIORef coreRef (Just (button, val)))
            (do core <- readIORef coreRef
                case core of
                    Nothing -> return Nothing
                    Just (_,val) -> return (Just val))
            (paraName <<<- ParaName "" $ parameters)
            notifier
        where
        buttonHandler coreRef e = do
            core <- readIORef coreRef
            case core of
                Nothing -> error "You have to inject a value before the button can be clicked"
                Just (b,val) -> do
                    res <- func val (getParameter paraName parameters)
                    case res of
                        Nothing     -> return (e{gtkReturn=True})
                        Just nval   -> do
                            writeIORef coreRef (Just (b, nval))
                            return (e{gtkReturn=True})

    okCancelFields :: FieldDescription ()
    okCancelFields = HFD emptyParams [
            mkField
                (paraStockId <<<- ParaStockId stockCancel
                    $ paraName <<<- ParaName "Cancel"
                        $ emptyParams)
                (const ())
                (\ _ b -> b)
                (clickEditor False)
        ,   mkField
                (paraStockId <<<- ParaStockId stockOk
                    $ paraName <<<- ParaName "Ok"
                        $ emptyParams)
                (const ())
                (\ a b -> b)
                (clickEditor True)]