ltk 0.8.0.8 → 0.10.0

raw patch · 8 files changed

+360/−217 lines, 8 filesdep ~Cabaldep ~basedep ~containersPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Cabal, base, containers, filepath, ghc, glib, gtk, haddock, mtl

API changes (from Hackage documentation)

Files

• ltk.cabal +6/−6
• src/Control/Event.hs +19/−6
• src/Graphics/UI/Editor/Basics.hs +62/−30
• src/Graphics/UI/Editor/Composite.hs +164/−89
• src/Graphics/UI/Editor/MakeEditor.hs +12/−18
• src/Graphics/UI/Editor/Simple.hs +84/−53
• src/Graphics/UI/Frame/Panes.hs +2/−7
• src/Graphics/UI/Frame/ViewFrame.hs +11/−8

@@ -1,18 +1,18 @@ name: ltk-version: 0.8.0.8+version: 0.10.0 cabal-version: -any build-type: Simple license: GPL license-file: LICENSE copyright: Juergen "jutaro" Nicklisch-Franken maintainer: maintainer@leksah.org-build-depends: Cabal >=1.6.0 && <1.9, base >=4.0.0.0 && <4.3,-               containers >=0.2 && <0.4, filepath >=1.1.0 && <1.2,-               glib >=0.10.0 && <0.12, gtk >=0.10.0 && <0.12,-               mtl >=1.1.0.2 && <1.2, parsec >=2.1.0.1 && <2.2,+build-depends: Cabal >=1.6.0 && <1.11, base >=4.0.0.0 && <4.4,+               containers >=0.2 && <0.5, filepath >=1.1.0 && <1.3,+               glib >=0.10.0 && <0.13, gtk >=0.10.0 && <0.13,+               mtl >=1.1.0.2 && <2.1, parsec >=2.1.0.1 && <2.2,                pretty >=1.0.1.0 && <1.1,                -- Make sure we get the Cabal compaitble with ghc and haddock-               haddock <2.8, ghc <6.13+               haddock <2.10, ghc <7.3 stability: homepage: http://www.leksah.org package-url: http://code.haskell.org/ltk

@@ -17,12 +17,15 @@ ,   Event(..) ,   EventSource(..) ,   Handlers++,   registerEvents ) where  import Data.Map (Map) import qualified Data.Map as Map import Data.Unique import Control.Monad+import Data.Maybe (catMaybes)  -- | Every event needs a selector, which should identify the type of event class (Eq delta, Ord delta, Show delta) =>  EventSelector delta@@ -35,6 +38,10 @@ type Handlers beta gamma delta = Map delta [(Unique, beta  -> gamma beta)]  -- | Everything which is an event source needs this+-- alpha is the Notifier+-- beta is the event+-- gamma is the monad+-- delta is the event selector class (Monad gamma, Event beta delta) => EventSource alpha beta gamma delta         | alpha -> beta, alpha -> gamma where     getHandlers     ::  alpha -> gamma (Handlers beta gamma delta)@@ -46,6 +53,7 @@     canTriggerEvent _ _             =   False      -- | Returns the event, so that you may get values back from an event+    -- Args: Notifier, Event     triggerEvent ::  alpha -> beta -> gamma beta     triggerEvent o e    =         if canTriggerEvent o (getSelector e)@@ -57,11 +65,10 @@                     Just l      ->  foldM (\e (_,ah) -> ah e) e (reverse l)             else error $ "Can't trigger event " ++ show (getSelector e) -    -- | use Left to register and Right to unregister     -- returns Unique if registration was successfull, else Nothing-    registerEvent   ::  alpha -> delta-        -> Either (beta -> gamma beta) Unique -> gamma (Maybe Unique)-    registerEvent o e (Left handler) =+    -- Args: Notifier, EventSelector, Handler (Event -> Monad Event)+    registerEvent   ::  alpha -> delta -> (beta -> gamma beta) -> gamma (Maybe Unique)+    registerEvent o e handler =         if canTriggerEvent o e             then do                 handlerMap  <-  getHandlers o@@ -72,7 +79,11 @@                 setHandlers o newHandlers                 return (Just unique)             else error $ "Can't register event " ++ show e-    registerEvent o e (Right unique) =++    -- | use Left to register and Right to unregister+    -- Args: Notifier, EventSelector, Unique+    unregisterEvent   ::  alpha -> delta -> Unique -> gamma ()+    unregisterEvent o e unique =         if canTriggerEvent o e             then do                 handlerMap  <-  getHandlers o@@ -81,6 +92,8 @@                                         Just l -> let newList = filter (\ (mu,_) -> mu /= unique) l                                                   in  Map.insert e newList handlerMap                 setHandlers o newHandlers-                return (Just unique)+                return ()             else error $ "Can't register event " ++ show e +registerEvents :: EventSource alpha beta gamma delta => alpha -> [delta] -> (beta -> gamma beta) -> gamma [Unique]+registerEvents o l handler = liftM catMaybes (mapM  (\ e -> registerEvent o e handler) l)

@@ -1,4 +1,5 @@-{-# OPTIONS_GHC -XMultiParamTypeClasses -XScopedTypeVariables #-}+{-# OPTIONS_GHC -XMultiParamTypeClasses -XScopedTypeVariables -XFlexibleContexts -XRankNTypes+    -XExistentialQuantification #-}  ----------------------------------------------------------------------------- --@@ -29,10 +30,14 @@ ,   GtkRegFunc ,   Notifier(..) ,   GtkHandler+,   Connection(..)+,   Connections  ,   activateEvent ,   propagateEvent ,   allGUIEvents+,   genericGUIEvents+,   propagateAsChanged ) where  import Graphics.UI.Gtk@@ -89,7 +94,7 @@ data GUIEvent = GUIEvent {     selector :: GUIEventSelector ,   gtkEvent :: Gtk.Event-,   eventPaneName :: String+,   eventText :: String ,   gtkReturn :: Bool -- ^ True means that the event has been completely handled,                       --  gtk shoudn't do any further action about it (Often not                       --  a good idea@@ -97,18 +102,20 @@ instance Event GUIEvent GUIEventSelector where     getSelector = selector -data GUIEventSelector =   Clicked-                    |   FocusOut-                    |   FocusIn-                    |   SelectionChanged-                    |   ButtonRelease-                    |   AfterKeyRelease+data GUIEventSelector = FocusOut        -- ^ generic, the widget looses the focus+                    |   FocusIn         -- ^ generic, the widget gets the focus+                    |   ButtonPressed   -- ^ generic, a mouse key has been pressed and released, while the widget has the focus+                    |   KeyPressed      -- ^ generic, a keyboard key has been pressed and released, while the widget has the focus+                    |   Clicked         -- ^ button specific, the button has been pressed+                    |   MayHaveChanged  -- ^ generic, no gui event, the contents of the widget may have changed+                    |   ValidationError -- ^ validation of a contents has failed     deriving (Eq,Ord,Show,Enum,Bounded)  instance EventSelector GUIEventSelector  allGUIEvents :: [GUIEventSelector] allGUIEvents = allOf+genericGUIEvents = [FocusOut,FocusIn,ButtonPressed,KeyPressed]  -- ------------------------------------------------------------ -- * Implementation of GUI event system@@ -122,7 +129,7 @@ -- -- | A type for a function to register a gtk event -- |-type GtkRegFunc = Widget  -> GtkHandler -> IO (ConnectId Widget)+type GtkRegFunc = forall o . GObjectClass o => o -> GtkHandler -> IO (Connection)  -- -- | The widgets are the real event sources.@@ -134,7 +141,7 @@ -- are propageted. -- The last map is used to unregister propagated events properly ---type GUIEventReg = ([ConnectId Widget],+type GUIEventReg =  ([Connection],                         ([Notifier], Map Unique [(Unique,Notifier)]))  --@@ -152,6 +159,13 @@     let noti      =  Noti h     return noti +--+-- | Signal handlers for the different pane types+--+data Connection =  forall alpha . GObjectClass alpha => ConnectC (ConnectId alpha)++type Connections = [Connection]+ instance  EventSource Notifier GUIEvent IO GUIEventSelector where     getHandlers (Noti pairRef)              =   do         (h,_) <- readIORef pairRef@@ -165,7 +179,7 @@      canTriggerEvent _ _                     =   True -    registerEvent o@(Noti pairRef) eventSel hand@(Left handler) =   do+    registerEvent o@(Noti pairRef) eventSel hand =   do         (handlers, ger)     <-  readIORef pairRef         unique              <-  myUnique o         newGer <- case Map.lookup eventSel ger of@@ -181,12 +195,13 @@                         return (Map.insert eventSel (cids,(notifiers,newUm)) ger)         let newHandlers =   case eventSel `Map.lookup` handlers of                                 Nothing -> Map.insert eventSel-                                                [(unique,handler)] handlers+                                                [(unique,hand)] handlers                                 Just l  -> Map.insert eventSel-                                                ((unique,handler):l) handlers+                                                ((unique,hand):l) handlers         writeIORef pairRef (newHandlers,newGer)         return (Just unique)-    registerEvent o@(Noti pairRef) eventSel (Right unique) =   do++    unregisterEvent o@(Noti pairRef) eventSel unique =   do         (handlers, ger) <- readIORef pairRef         newGer <- case Map.lookup eventSel ger of             Nothing -> return ger@@ -194,7 +209,7 @@                 case unique `Map.lookup` um of                     Nothing ->  return ger                     Just l  ->  do-                        mapM_  (\(u,es) -> registerEvent es eventSel (Right u)) l+                        mapM_  (\(u,es) -> unregisterEvent es eventSel u) l                         let newUm = unique `Map.delete` um                         return (Map.insert eventSel (cids,(notis,newUm)) ger)         let newHandlers =   case eventSel `Map.lookup` handlers of@@ -203,7 +218,7 @@                                             [] -> Map.delete eventSel handlers                                             l  -> Map.insert eventSel l handlers         writeIORef pairRef (newHandlers,newGer)-        return (Just unique)+        return ()  -- -- | Propagate the event with the selector from notifier to eventSource@@ -230,7 +245,7 @@         case Map.lookup eventSel ger of             Just (cids,(notifiers,um))                 -> do-                    lu <-  mapM (\es -> registerEvent es eventSel (Left hand))+                    lu <-  mapM (\es -> registerEvent es eventSel hand)                                     notifiers                     let jl =  map (first fromJust)                                     $ filter (isJust.fst)@@ -243,7 +258,14 @@ -- | Activate the event after the event has been declared and the -- widget has been constructed ---activateEvent :: Widget -> Notifier -> Maybe GtkRegFunc -> GUIEventSelector  -> IO()++activateEvent+  :: (GObjectClass o) =>+     o+     -> Notifier+     -> Maybe (o -> GtkHandler -> IO Connection)+     -> GUIEventSelector+     -> IO () activateEvent widget (Noti pairRef) mbRegisterFunc eventSel = do     let registerFunc    =   case mbRegisterFunc of                                 Just f  ->  f@@ -254,9 +276,11 @@                     Nothing -> return False                     Just [] -> return False                     Just handlers -> do-                        name <- widgetGetName widget+                        name <- if (widget `isA` gTypeWidget)+                                    then widgetGetName (castToWidget widget)+                                    else return "no widget - no name"                         eventList <- mapM (\f -> do-                            let ev = GUIEvent eventSel e name False+                            let ev = GUIEvent eventSel e "" False                             f ev)                                 (map snd handlers)                         let boolList = map gtkReturn eventList@@ -273,13 +297,21 @@ -- | A convinence method for not repeating this over and over again -- getStandardRegFunction :: GUIEventSelector -> GtkRegFunc-getStandardRegFunction FocusOut         =   \w h -> w `onFocusOut` h-getStandardRegFunction FocusIn          =   \w h -> w `onFocusIn` h-getStandardRegFunction ButtonRelease    =   \w h -> w `onButtonRelease` h-getStandardRegFunction AfterKeyRelease  =   \w h -> w `afterKeyRelease` h-getStandardRegFunction Clicked          =   \w h -> do-        res     <-  onClicked (castToButton w) (do-                        h (Gtk.Event True)-                        return ())-        return (unsafeCoerce res)-getStandardRegFunction SelectionChanged =   error "yet not implemented"+getStandardRegFunction FocusOut         =   \w h -> liftM ConnectC $ (castToWidget w) `onFocusOut` h+getStandardRegFunction FocusIn          =   \w h -> liftM ConnectC $ (castToWidget w) `onFocusIn` h+getStandardRegFunction ButtonPressed    =   \w h -> liftM ConnectC $ (castToWidget w) `afterButtonRelease` h+getStandardRegFunction KeyPressed       =   \w h -> liftM ConnectC $ (castToWidget w) `afterKeyRelease` h+getStandardRegFunction Clicked          =   \w h -> liftM ConnectC $ (castToButton w) `onClicked`+                                                                    (h (Gtk.Event True) >> return ())+getStandardRegFunction _    =   error "Basic>>getStandardRegFunction: no original GUI event"++registerEvents :: EventSource alpha beta gamma delta => alpha -> [delta] -> (beta -> gamma beta) -> gamma [Maybe Unique]+registerEvents notifier selectors handler =+    mapM (\ s -> registerEvent notifier s handler) selectors++propagateAsChanged+  :: (EventSource alpha GUIEvent m GUIEventSelector) =>+     alpha -> [GUIEventSelector] -> m ()+propagateAsChanged notifier selectors =+    mapM_ (\s -> registerEvent notifier s+            (\ e -> triggerEvent notifier e{selector = MayHaveChanged})) selectors

@@ -14,12 +14,9 @@  module Graphics.UI.Editor.Composite (     maybeEditor+,   disableEditor ,   pairEditor ,   tupel3Editor---,   tupel4Editor---,   tupel5Editor---,   tupel6Editor---,   tupel7Editor ,   splitEditor ,   eitherOrEditor ,   multisetEditor@@ -57,6 +54,8 @@ import Distribution.Package (pkgName) import Data.Version (Version(..)) import MyMissing (forceJust)+import qualified Graphics.UI.Gtk.Gdk.Events as Gtk (Event(..))+import Unsafe.Coerce (unsafeCoerce)  -- -- | An editor which composes two subeditors@@ -66,7 +65,7 @@     coreRef <- newIORef Nothing     noti1   <- emptyNotifier     noti2   <- emptyNotifier-    mapM_ (propagateEvent notifier [noti2]) allGUIEvents+    mapM_ (propagateEvent notifier [noti1,noti2]) allGUIEvents     fst@(fstFrame,inj1,ext1) <- fstEd fstPara noti1     snd@(sndFrame,inj2,ext2) <- sndEd sndPara noti2     mkEditor@@ -111,7 +110,7 @@     noti1   <- emptyNotifier     noti2   <- emptyNotifier     noti3   <- emptyNotifier-    mapM_ (propagateEvent notifier [noti2]) allGUIEvents+    mapM_ (propagateEvent notifier [noti1,noti2,noti3]) (Clicked : allGUIEvents)     r1@(frame1,inj1,ext1) <- (fst p1) (snd p1) noti1     r2@(frame2,inj2,ext2) <- (fst p2) (snd p2) noti2     r3@(frame3,inj3,ext3) <- (fst p3) (snd p3) noti3@@ -152,74 +151,6 @@         parameters         notifier -{---tupel4Editor :: (Editor alpha, Parameters)-    -> (Editor beta, Parameters)-    -> (Editor gamma, Parameters)-    -> (Editor delta, Parameters)-    -> Editor (alpha,beta,gamma,delta)-tupel4Editor p1 p2 p3 p4 parameters notifier = do-    (widg,inj,ext) <- pairEditor ((tupel3Editor p1 p2 p3), parameters) p4 parameters notifier-    return (widg,-        (\ (a, b, c, d) -> inj ((a,b,c),d)),-        (do-            mb <- ext-            case mb of-                Nothing        -> return Nothing-                Just ((a,b,c),d) -> return (Just (a,b,c,d))))--tupel5Editor :: (Editor alpha, Parameters)-    -> (Editor beta, Parameters)-    -> (Editor gamma, Parameters)-    -> (Editor delta, Parameters)-    -> (Editor epsilon, Parameters)-    -> Editor (alpha,beta,gamma,delta,epsilon)-tupel5Editor p1 p2 p3 p4 p5 parameters notifier = do-    (widg,inj,ext) <- pairEditor ((tupel4Editor p1 p2 p3 p4), parameters) p5 parameters notifier-    return (widg,-        (\ (a, b, c, d, e) -> inj ((a,b,c,d),e)),-        (do-            mb <- ext-            case mb of-                Nothing        -> return Nothing-                Just ((a,b,c,d),e) -> return (Just (a,b,c,d,e))))--tupel6Editor :: (Editor alpha, Parameters)-    -> (Editor beta, Parameters)-    -> (Editor gamma, Parameters)-    -> (Editor delta, Parameters)-    -> (Editor epsilon, Parameters)-    -> (Editor zeta, Parameters)-    -> Editor (alpha,beta,gamma,delta,epsilon,zeta)-tupel6Editor p1 p2 p3 p4 p5 p6 parameters notifier = do-    (widg,inj,ext) <- pairEditor ((tupel5Editor p1 p2 p3 p4 p5), parameters) p6 parameters notifier-    return (widg,-        (\ (a, b, c, d, e, f) -> inj ((a,b,c,d,e),f)),-        (do-            mb <- ext-            case mb of-                Nothing        -> return Nothing-                Just ((a,b,c,d,e),f) -> return (Just (a,b,c,d,e,f))))--tupel7Editor :: (Editor alpha, Parameters)-    -> (Editor beta, Parameters)-    -> (Editor gamma, Parameters)-    -> (Editor delta, Parameters)-    -> (Editor epsilon, Parameters)-    -> (Editor zeta, Parameters)-    -> (Editor eta, Parameters)-    -> Editor (alpha,beta,gamma,delta,epsilon,zeta,eta)-tupel7Editor p1 p2 p3 p4 p5 p6 p7 parameters notifier = do-    (widg,inj,ext) <- pairEditor ((tupel6Editor p1 p2 p3 p4 p5 p6), parameters) p7 parameters notifier-    return (widg,-        (\ (a, b, c, d, e, f, g) -> inj ((a,b,c,d,e,f),g)),-        (do-            mb <- ext-            case mb of-                Nothing        -> return Nothing-                Just ((a,b,c,d,e,f),g) -> return (Just (a,b,c,d,e,f,g))))---}- -- -- | Like a pair editor, but with a moveable split --@@ -268,13 +199,10 @@ -- maybeEditor :: Default beta => (Editor beta, Parameters) -> Bool -> String -> Editor (Maybe beta) maybeEditor (childEdit, childParams) positive boolLabel parameters notifier = do-    coreRef <- newIORef Nothing-    childRef  <- newIORef Nothing+    coreRef      <- newIORef Nothing+    childRef     <- newIORef Nothing     notifierBool <- emptyNotifier-    cNoti   <- emptyNotifier-    mapM_ (propagateEvent notifier [notifierBool]) [Clicked,FocusIn]-    mapM_ (propagateEvent notifier [cNoti]) allGUIEvents-+    cNoti        <- emptyNotifier     mkEditor         (\widget mbVal -> do             core <- readIORef coreRef@@ -292,7 +220,8 @@                         notifierBool                     boxPackStart box boolFrame PackNatural 0                     containerAdd widget box-                    registerEvent notifierBool Clicked (Left (onClickedHandler widget coreRef childRef cNoti))+                    registerEvent notifierBool Clicked (onClickedHandler widget coreRef childRef cNoti)+                    propagateEvent notifier [notifierBool] MayHaveChanged                     case mbVal of                         Nothing -> inj1 (not positive)                         Just val -> do@@ -377,14 +306,150 @@             Nothing -> do                 let val = childEditor                 editor@(_,_,_) <- childEditor childParams cNoti+                mapM_ (propagateEvent notifier [cNoti]) allGUIEvents                 writeIORef childRef (Just editor)                 return editor     hasChildEditor childRef =  do         mb <- readIORef childRef         return (isJust mb) + -- -- | An editor with a subeditor which gets active, when a checkbox is selected+-- or grayed out (if the positive Argument is False)+--+disableEditor :: Default beta => (Editor beta, Parameters) -> Bool -> String -> Editor (Bool,beta)+disableEditor (childEdit, childParams) positive boolLabel parameters notifier = do+    coreRef      <- newIORef Nothing+    childRef     <- newIORef Nothing+    notifierBool <- emptyNotifier+    cNoti        <- emptyNotifier+    mkEditor+        (\widget mbVal -> do+            core <- readIORef coreRef+            case core of+                Nothing  -> do+                    box <- case getParameter paraDirection parameters of+                        Horizontal -> do+                            b <- hBoxNew False 1+                            return (castToBox b)+                        Vertical -> do+                            b <- vBoxNew False 1+                            return (castToBox b)+                    be@(boolFrame,inj1,ext1) <- boolEditor+                        (paraName <<<- ParaName boolLabel $ emptyParams)+                        notifierBool+                    boxPackStart box boolFrame PackNatural 0+                    containerAdd widget box+                    registerEvent notifierBool Clicked+                        (onClickedHandler widget coreRef childRef cNoti)+                    propagateEvent notifier [notifierBool] MayHaveChanged+                    case mbVal of+                        (False,val) -> do+                            (childWidget,inj2,ext2) <- getChildEditor childRef childEdit childParams cNoti+                            boxPackEnd box childWidget PackGrow 0+                            widgetShowAll childWidget+                            inj1 ( not positive)+                            inj2 val+                            widgetSetSensitive childWidget False+                        (True,val) -> do+                            (childWidget,inj2,ext2) <- getChildEditor childRef childEdit childParams cNoti+                            boxPackEnd box childWidget PackGrow 0+                            widgetShowAll childWidget+                            inj1 positive+                            inj2 val+                            widgetSetSensitive childWidget True+                    writeIORef coreRef (Just (be,box))+                Just (be@(boolFrame,inj1,extt),box) -> do+                    hasChild <- hasChildEditor childRef+                    case mbVal of+                        (False,val) ->+                            if hasChild+                                then do+                                    (childWidget,_,_) <- getChildEditor childRef childEdit childParams cNoti+                                    inj1 (not positive)+                                    widgetSetSensitive childWidget False+                                else inj1 (not positive)+                        (True,val) ->+                            if hasChild+                                then do+                                    inj1 positive+                                    (childWidget,inj2,_) <- getChildEditor childRef childEdit childParams cNoti+                                    inj2 val+                                    widgetSetSensitive childWidget True+                                else do+                                    inj1 positive+                                    (childWidget,inj2,_) <- getChildEditor childRef childEdit childParams cNoti+                                    boxPackEnd box childWidget PackGrow 0+                                    widgetSetSensitive childWidget True+                                    inj2 val)+        (do+            core <- readIORef coreRef+            case core of+                Nothing  -> return Nothing+                Just (be@(boolFrame,inj1,ext1),_) -> do+                    bool <- ext1+                    case bool of+                        Nothing -> return Nothing+                        Just bv | bv == positive -> do+                            (_,_,ext2) <- getChildEditor childRef childEdit childParams cNoti+                            value <- ext2+                            case value of+                                Nothing -> return Nothing+                                Just value -> return (Just (True, value))+                        otherwise -> do+                            (_,_,ext2) <- getChildEditor childRef childEdit childParams cNoti+                            value <- ext2+                            case value of+                                Nothing -> return Nothing+                                Just value -> return (Just (False, value)))+        parameters+        notifier+    where+    onClickedHandler widget coreRef childRef cNoti event = do+        core <- readIORef coreRef+        case core of+            Nothing  -> error "Impossible"+            Just (be@(boolFrame,inj1,ext1),vBox) -> do+                mbBool <- ext1+                case mbBool of+                    Just bool ->+                        if bool /= positive+                            then do++                                hasChild <- hasChildEditor childRef+                                when hasChild $ do+                                    (childWidget,_,_) <- getChildEditor childRef childEdit childParams cNoti+                                    widgetSetSensitive childWidget False+                            else do+                                hasChild <- hasChildEditor childRef+                                if hasChild+                                    then do+                                        (childWidget,_,_) <- getChildEditor childRef childEdit childParams cNoti+                                        widgetSetSensitive childWidget True+                                    else do+                                        (childWidget,inj2,_) <- getChildEditor childRef childEdit childParams cNoti+                                        boxPackEnd vBox childWidget PackNatural 0+                                        inj2 getDefault+                                        widgetSetSensitive childWidget True+                    Nothing -> return ()+                return (event {gtkReturn=True})+    getChildEditor childRef childEditor childParams cNoti =  do+        mb <- readIORef childRef+        case mb of+            Just editor -> return editor+            Nothing -> do+                let val = childEditor+                editor@(_,_,_) <- childEditor childParams cNoti+                mapM_ (propagateEvent notifier [cNoti]) allGUIEvents+                writeIORef childRef (Just editor)+                return editor+    hasChildEditor childRef =  do+        mb <- readIORef childRef+        return (isJust mb)++--+-- | An editor with a subeditor which gets active, when a checkbox is selected -- or deselected (if the positive Argument is False) eitherOrEditor :: (Default alpha, Default beta) => (Editor alpha, Parameters) ->                         (Editor beta, Parameters) -> String -> Editor (Either alpha beta)@@ -403,7 +468,7 @@             core <- readIORef coreRef             case core of                 Nothing  -> do-                    registerEvent noti1 Clicked (Left (onClickedHandler widget coreRef))+                    registerEvent noti1 Clicked (onClickedHandler widget coreRef)                     box <- case getParameter paraDirection parameters of                         Horizontal -> do                             b <- hBoxNew False 1@@ -497,7 +562,6 @@         parameters notifier = do     coreRef <- newIORef Nothing     cnoti   <- emptyNotifier-    mapM_ (propagateEvent notifier [cnoti]) allGUIEvents     mkEditor         (\widget vs -> do             core <- readIORef coreRef@@ -513,11 +577,22 @@                             bb <- hButtonBoxNew                             return (castToBox b,castToButtonBox bb)                     (frameS,injS,extS) <- singleEditor sParams cnoti+                    mapM_ (propagateEvent notifier [cnoti]) allGUIEvents                     addButton   <- buttonNewWithLabel "Add"                     removeButton <- buttonNewWithLabel "Remove"                     containerAdd buttonBox addButton                     containerAdd buttonBox removeButton                     listStore   <-  listStoreNew ([]:: [alpha])+                    activateEvent listStore notifier+                        (Just (\ w h -> do+                            res     <-  after (castToTreeModel w) rowInserted (\ _ _ ->+                                h (Gtk.Event True) >> return ())+                            return (ConnectC res))) MayHaveChanged+                    activateEvent listStore notifier+                        (Just (\ w h -> do+                            res     <-  after (castToTreeModel w) rowDeleted (\ _ ->+                                h (Gtk.Event True) >> return ())+                            return (ConnectC res))) MayHaveChanged                     treeView        <-  treeViewNewWithModel listStore                     let minSize =   getParameter paraMinSize parameters                     uncurry (widgetSetSizeRequest treeView) minSize@@ -601,7 +676,7 @@         (paraMinSize <<<- ParaMinSize (-1,-1) $ parameters)         notifier     where-    selectionHandler :: TreeSelection -> ListStore a -> Injector a -> IO ()+--    selectionHandler :: TreeSelection -> ListStore a -> Injector a -> IO ()     selectionHandler sel listStore inj = do         ts <- treeSelectionGetSelected sel         case ts of@@ -623,11 +698,11 @@         (paraShadow <<<- ParaShadow ShadowIn $             paraDirection  <<<- ParaDirection Vertical $ p) -stringsEditor :: (String -> Bool) -> Editor [String]-stringsEditor validation p =+stringsEditor :: (String -> Bool) -> Bool -> Editor [String]+stringsEditor validation trimBlanks p =     multisetEditor         (ColumnDescr False [("",(\row -> [cellText := row]))])-        (stringEditor validation, emptyParams)+        (stringEditor validation trimBlanks, emptyParams)         (Just sort)         (Just (==))         (paraShadow <<<- ParaShadow ShadowIn $ p)@@ -637,7 +712,7 @@     (wid,inj,ext) <- pairEditor         ((eitherOrEditor (comboSelectionEditor ((sort . nub) (map (display . pkgName) packages)) id             , paraName <<<- ParaName "Select" $ emptyParams)-            (stringEditor (const True), paraName <<<- ParaName "Enter" $ emptyParams)+            (stringEditor (const True) True, paraName <<<- ParaName "Enter" $ emptyParams)             "Select from list?"), paraName <<<- ParaName "Name"$ emptyParams)         (versionRangeEditor,paraName <<<- ParaName "Version" $ emptyParams)         (paraDirection <<<- ParaDirection Vertical $ para)@@ -754,7 +829,7 @@  versionEditor :: Editor Version versionEditor para noti = do-    (wid,inj,ext) <- stringEditor (\s -> not (null s)) para noti+    (wid,inj,ext) <- stringEditor (\s -> not (null s)) True para noti     let pinj v = inj (display v)     let pext = do         s <- ext

@@ -30,13 +30,15 @@  import Graphics.UI.Gtk import Control.Monad-import Data.List(unzip4)+import Data.List (intersperse, unzip4)  import Control.Event import Graphics.UI.Editor.Parameters import Graphics.UI.Editor.Basics --import Graphics.UI.Frame.ViewFrame import Data.Maybe (isNothing)+import Data.IORef (newIORef)+import qualified Graphics.UI.Gtk.Gdk.Events as GTK (Event(..))  -- -- | A constructor type for a field desciption@@ -140,9 +142,9 @@                                     Just s -> s                                     Nothing -> "Unnamed") descrs     let packParas = map (\fd -> getParameter paraPack (parameters fd)) descrs-    let newExt = (\v -> extractAndValidate v getExts fieldNames)-    mapM_ (\ (w,p) -> boxPackStart hb w p 0) $ zip widgets packParas     mapM_ (propagateEvent notifier notifiers) allGUIEvents+    let newExt = (\v -> extractAndValidate v getExts fieldNames notifier)+    mapM_ (\ (w,p) -> boxPackStart hb w p 0) $ zip widgets packParas     return (castToWidget hb, newInj, newExt, notifier)  @@ -170,15 +172,6 @@                             case b of                                 Just b -> return (Just (setter b a))                                 Nothing -> return Nothing)-            registerEvent noti FocusOut (Left (\e ->  do-                let name = eventPaneName e-                e2 <- ext-                when (isNothing e2) $ do-                    md <- messageDialogNew Nothing [] MessageWarning ButtonsClose-                        $ "The field " ++ name ++ " has an invalid value "-                    dialogRun md-                    widgetDestroy md-                return (e{gtkReturn=False})))             inj (getter dat)             return (widget,                     (\a -> inj (getter a)),@@ -216,8 +209,8 @@  -- | Convenience method to validate and extract fields ---extractAndValidate :: alpha -> [alpha -> Extractor alpha] -> [String] -> IO (Maybe alpha)-extractAndValidate val getExts fieldNames = do+extractAndValidate :: alpha -> [alpha -> Extractor alpha] -> [String] -> Notifier -> IO (Maybe alpha)+extractAndValidate val getExts fieldNames notifier = do     (newVal,errors) <- foldM (\ (val,errs) (ext,fn) -> do         extVal <- ext val         case extVal of@@ -227,10 +220,11 @@     if null errors         then return (Just newVal)         else do-            md <- messageDialogNew Nothing [] MessageWarning ButtonsClose-                     $ "The following fields have invalid values." ++ concat (reverse errors)-            dialogRun md-            widgetDestroy md+            triggerEvent notifier (GUIEvent {+                    selector = ValidationError,+                    gtkEvent = GTK.Event True,+                    eventText = concat (intersperse ", " errors),+                    gtkReturn = True})             return Nothing  extract :: alpha -> [alpha -> Extractor alpha] -> IO (Maybe alpha)

@@ -49,7 +49,7 @@ import System.FilePath.Posix  import Graphics.UI.Editor.Parameters-import Graphics.UI.Editor.Basics+--import Graphics.UI.Editor.Basics import Graphics.UI.Editor.MakeEditor import Control.Event #if MIN_VERSION_gtk(0,10,5)@@ -57,7 +57,12 @@ #else import Graphics.UI.Gtk.Gdk.Events (Event(..)) #endif-import MyMissing (allOf)+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@@ -94,7 +99,8 @@                     containerAdd widget button                     toggleButtonSetActive button bool                     mapM_ (activateEvent (castToWidget button) notifier Nothing)-                        [Clicked,FocusOut,FocusIn]+                        (Clicked: genericGUIEvents)+                    propagateAsChanged notifier [Clicked]                     writeIORef coreRef (Just button)                 Just button -> toggleButtonSetActive button bool)         (do core <- readIORef coreRef@@ -128,10 +134,9 @@                     if bool                         then toggleButtonSetActive radio1 True                         else toggleButtonSetActive radio2 True-                    mapM_ (activateEvent (castToWidget radio1) notifier Nothing)-                                [Clicked,FocusOut,FocusIn]-                    mapM_ (activateEvent (castToWidget radio2) notifier Nothing)-                                [Clicked,FocusOut,FocusIn]+                    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@@ -175,8 +180,8 @@                         (\e ->                             (mapM_                                 (\b -> activateEvent (castToWidget b) notifier Nothing e)-                             buttons))-                        [Clicked,FocusOut,FocusIn]+                             buttons)) (Clicked:genericGUIEvents)+                    propagateAsChanged notifier [Clicked]                     mapM_ (\(b,n) -> toggleButtonSetActive b (n == fromEnum enumValue))                                 (zip buttons [0..length buttons - 1])                     writeIORef coreRef (Just buttons)@@ -198,8 +203,8 @@  -- | An Editor for nothing (which may report a click) in the form of a button ---clickEditor :: Editor ()-clickEditor parameters notifier = do+clickEditor :: Bool -> Editor ()+clickEditor canDefault parameters notifier = do     coreRef <- newIORef Nothing     mkEditor         (\widget bool -> do@@ -213,6 +218,9 @@                     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)@@ -243,8 +251,8 @@ -- -- | Editor for a string in the form of a text entry ---stringEditor :: (String -> Bool) -> Editor String-stringEditor validation parameters notifier = do+stringEditor :: (String -> Bool) -> Bool -> Editor String+stringEditor validation trimBlanks parameters notifier = do     coreRef <- newIORef Nothing     mkEditor         (\widget string -> do@@ -253,19 +261,19 @@                 Nothing  -> do                     entry   <-  entryNew                     widgetSetName entry (getParameter paraName parameters)-                    mapM_ (activateEvent (castToWidget entry) notifier Nothing)-                                [FocusOut,FocusIn,AfterKeyRelease]+                    mapM_ (activateEvent (castToWidget entry) notifier Nothing) genericGUIEvents+                    propagateAsChanged notifier [KeyPressed]                     containerAdd widget entry-                    entrySetText entry string+                    entrySetText entry (if trimBlanks then trim string else string)                     writeIORef coreRef (Just entry)-                Just entry -> entrySetText entry string)+                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 r)+                        then return (Just (if trimBlanks then trim r else r))                         else return Nothing)         parameters         notifier@@ -287,8 +295,8 @@                     scrolledWindowSetPolicy aScrolledWindow PolicyAutomatic PolicyAutomatic                     containerAdd aScrolledWindow aTextView                     containerAdd widget aScrolledWindow-                    mapM_ (activateEvent (castToWidget aTextView) notifier Nothing)-                        [ButtonRelease,FocusOut,FocusIn]+                    mapM_ (activateEvent (castToWidget aTextView) notifier Nothing) genericGUIEvents+                    propagateAsChanged notifier [KeyPressed]                     buffer          <-  textViewGetBuffer aTextView                     textBufferSetText buffer string                     writeIORef coreRef (Just (aScrolledWindow,aTextView))@@ -320,8 +328,13 @@                 Nothing  -> do                     spin <- spinButtonNewWithRange min max step                     widgetSetName spin (getParameter paraName parameters)-                    mapM_ (activateEvent (castToWidget spin) notifier Nothing)-                                [FocusOut,FocusIn]+                    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)@@ -340,7 +353,7 @@ -- | text entry genericEditor :: (Show beta, Read beta) => Editor beta genericEditor parameters notifier = do-    (wid,inj,ext) <- stringEditor (const True) parameters notifier+    (wid,inj,ext) <- stringEditor (const True) True parameters notifier     let ginj = inj . show     let gext = do         s <- ext@@ -366,8 +379,7 @@                     button <- buttonNewWithLabel (getParameter paraName parameters)                     widgetSetName button (getParameter paraName parameters)                     containerAdd widget button-                    mapM_ (activateEvent (castToWidget button) notifier Nothing)-                                [Clicked,FocusIn]+                    mapM_ (activateEvent (castToWidget button) notifier Nothing) (Clicked:genericGUIEvents)                     writeIORef coreRef (Just button)                 Just button -> return ())         (return (Just ()))@@ -389,8 +401,13 @@                     combo <- comboBoxNewText                     mapM_ (\o -> comboBoxAppendText combo (showF o)) list                     widgetSetName combo (getParameter paraName parameters)-                    mapM_ (activateEvent (castToWidget combo) notifier Nothing)-                            [FocusOut,FocusIn]+                    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@@ -428,8 +445,8 @@                     listStore   <- listStoreNew ([]:: [alpha])                     listView    <- treeViewNewWithModel listStore                     widgetSetName listView (getParameter paraName parameters)-                    mapM_ (activateEvent (castToWidget listView) notifier Nothing)-                            [FocusOut,FocusIn]+                    mapM_ (activateEvent (castToWidget listView) notifier Nothing) genericGUIEvents+                    propagateAsChanged notifier [KeyPressed,ButtonPressed]                     sel         <- treeViewGetSelection listView                     treeSelectionSetMode sel SelectionMultiple                     renderer    <- cellRendererTextNew@@ -475,8 +492,8 @@                     listStore <- listStoreNew ([]:: [(Bool,beta)])                     listView <- treeViewNewWithModel listStore                     widgetSetName listView (getParameter paraName parameters)-                    mapM_ (activateEvent (castToWidget listView) notifier Nothing)-                            [FocusOut,FocusIn]+                    mapM_ (activateEvent (castToWidget listView) notifier Nothing) genericGUIEvents+                    propagateAsChanged notifier [KeyPressed,ButtonPressed]                     sel <- treeViewGetSelection listView                     treeSelectionSetMode sel SelectionSingle                     rendererToggle <- cellRendererToggleNew@@ -546,8 +563,8 @@                     listStore <- listStoreNew ([]:: [alpha])                     listView <- treeViewNewWithModel listStore                     widgetSetName listView (getParameter paraName parameters)-                    mapM_ (activateEvent (castToWidget listView) notifier Nothing)-                            [FocusOut,FocusIn]+                    mapM_ (activateEvent (castToWidget listView) notifier Nothing) genericGUIEvents+                    propagateAsChanged notifier [KeyPressed,ButtonPressed]                     sel <- treeViewGetSelection listView                     treeSelectionSetMode sel                         (case getParameter paraMultiSel parameters of@@ -608,13 +625,13 @@                     button <- buttonNewWithLabel buttonName                     widgetSetName button $ getParameter paraName parameters ++ "-button"                     mapM_ (activateEvent (castToWidget button) notifier Nothing)-                            [FocusOut,FocusIn,Clicked]+                        (Clicked:genericGUIEvents)                     entry   <-  entryNew                     widgetSetName entry $ getParameter paraName parameters ++ "-entry"                     -- set entry [ entryEditable := False ]-                    mapM_ (activateEvent (castToWidget entry) notifier Nothing)-                            [FocusOut,FocusIn]-                    registerEvent notifier Clicked (Left (buttonHandler entry))+                    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@@ -668,7 +685,11 @@ --                                Nothing -> fn --                                Just rel -> makeRelative rel fn                 entrySetText entry fn---                triggerEvent notifier SelectionChanged...+                triggerEvent notifier (GUIEvent {+                    selector = MayHaveChanged,+                    gtkEvent = Gtk.Event True,+                    eventText = "",+                    gtkReturn = True})                 return (e{gtkReturn=True})  --@@ -684,8 +705,13 @@                 Nothing  -> do                     fs <- fontButtonNew                     widgetSetName fs $ getParameter paraName parameters-                    mapM_ (activateEvent (castToWidget fs) notifier Nothing)-                            [FocusOut,FocusIn,Clicked]+                    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@@ -718,8 +744,13 @@                 Nothing  -> do                     cs <- colorButtonNew                     widgetSetName cs $ getParameter paraName parameters-                    mapM_ (activateEvent (castToWidget cs) notifier Nothing)-                            [FocusOut,FocusIn,Clicked]+                    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)@@ -748,9 +779,9 @@                     button <- buttonNewWithLabel (getParameter paraName parameters)                     widgetSetName button $ getParameter paraName parameters                     containerAdd widget button-                    mapM_ (activateEvent (castToWidget button) notifier Nothing)-                            [FocusOut,FocusIn,Clicked]-                    registerEvent notifier Clicked (Left (buttonHandler coreRef))+                    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@@ -775,17 +806,17 @@ okCancelFields :: FieldDescription () okCancelFields = HFD emptyParams [         mkField-            (paraStockId <<<- ParaStockId stockOk-                $ paraName <<<- ParaName "Ok"-                    $ emptyParams)-            (const ())-            (\ a b -> b)-            clickEditor-    ,   mkField             (paraStockId <<<- ParaStockId stockCancel                 $ paraName <<<- ParaName "Cancel"                     $ emptyParams)             (const ())             (\ _ b -> b)-            clickEditor]+            (clickEditor False)+    ,   mkField+            (paraStockId <<<- ParaStockId stockOk+                $ paraName <<<- ParaName "Ok"+                    $ emptyParams)+            (const ())+            (\ a b -> b)+            (clickEditor True)] 

@@ -44,6 +44,8 @@ import qualified Data.Map as Map import Data.Typeable import Control.Monad.Trans+import Graphics.UI.Editor.Basics+       (Connection(..), Connection, Connections)  -- --------------------------------------------------------------------- -- Panes and pane layout@@ -201,13 +203,6 @@  instance Show Notebook where     show _ = "a Notebook"------- | Signal handlers for the different pane types----data Connection =  forall alpha . GObjectClass alpha => ConnectC (ConnectId alpha)--type Connections = [Connection]  signalDisconnectAll :: Connections -> IO () signalDisconnectAll = mapM_ (\ (ConnectC s) -> signalDisconnect s)

@@ -118,7 +118,7 @@ import Graphics.UI.Editor.Simple (stringEditor, okCancelFields) import Control.Event (registerEvent) import Graphics.UI.Editor.Basics-    (eventPaneName, GUIEventSelector(..))+    (eventText, GUIEventSelector(..)) import qualified Data.Set as  Set (unions, member) import Data.Set (Set(..)) import Graphics.UI.Gtk.Gdk.Events (Event(..))@@ -133,9 +133,10 @@                             Nothing -> s                             Just s' -> s' + initGtkRc :: IO ()-initGtkRc = return ()-{--	rcParseString ("style \"leksah-close-button-style\"\n" +++#if MIN_VERSION_gtk(0,11,0)+initGtkRc = rcParseString ("style \"leksah-close-button-style\"\n" ++     "{\n" ++     "  GtkWidget::focus-padding = 0\n" ++     "  GtkWidget::focus-line-width = 0\n" ++@@ -143,7 +144,9 @@     "  ythickness = 0\n" ++     "}\n" ++     "widget \"*.leksah-close-button\" style \"leksah-close-button-style\"")---}+#else+initGtkRc = return ()+#endif  removePaneAdmin :: RecoverablePane alpha beta delta =>  alpha -> delta () removePaneAdmin pane = do@@ -625,11 +628,11 @@     lower                      <-   dialogGetActionArea dia     (widget,inj,ext,_)         <-   buildEditor moduleFields ""     (widget2,_,_,notifier)     <-   buildEditor okCancelFields ()-    registerEvent notifier Clicked (Left (\e -> do-            case eventPaneName e of+    registerEvent notifier ButtonPressed (\e -> do+            case eventText e of                 "Ok"    ->  dialogResponse dia ResponseOk                 _       ->  dialogResponse dia ResponseCancel-            return e))+            return e)     boxPackStart upper widget PackGrow 7     boxPackStart lower widget2 PackNatural 7     widgetShowAll dia@@ -647,7 +650,7 @@                             $ emptyParams)                     id                     (\ a b -> a)-            (stringEditor (\s -> True))]+            (stringEditor (const True) True)]  viewNest :: PaneMonad alpha => String -> alpha () viewNest group = do