{-# OPTIONS_GHC -XScopedTypeVariables #-} ----------------------------------------------------------------------------- -- -- Module : Graphics.UI.Editor.Simple -- Copyright : (c) Juergen Nicklisch-Franken, Hamish Mackenzie -- License : GNU-GPL -- -- Maintainer : -- 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) -- ------------------------------------------------------------ -- * 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 -> 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)]