diff --git a/LICENSE b/LICENSE --- a/LICENSE +++ b/LICENSE @@ -2,27 +2,30 @@ Copyright © 2011–2014 Wolfgang Jeltsch All rights reserved. -Redistribution and use in source and binary forms, with or without modification, -are permitted provided that the following conditions are met: +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are +met: - • Redistributions of source code must retain the above copyright notice, - this list of conditions and the following disclaimer. + • Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. - • Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. + • Redistributions in binary form must reproduce the above copyright + notice, this list of conditions and the following disclaimer in + the documentation and/or other materials provided with the + distribution. • Neither the name of the copyright holders nor the names of the - contributors may be used to endorse or promote products derived from this - software without specific prior written permission. + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR -TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF -THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS +IS” AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED +TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A +PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED +TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR +PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF +LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING +NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/grapefruit-ui-gtk.cabal b/grapefruit-ui-gtk.cabal --- a/grapefruit-ui-gtk.cabal +++ b/grapefruit-ui-gtk.cabal @@ -1,5 +1,5 @@ Name: grapefruit-ui-gtk -Version: 0.1.0.5 +Version: 0.1.0.6 Cabal-Version: >= 1.8 Build-Type: Simple License: BSD3 @@ -7,10 +7,10 @@ Copyright: © 2007–2009 Brandenburgische Technische Universität Cottbus © 2011–2014 Wolfgang Jeltsch Author: Wolfgang Jeltsch -Maintainer: wolfgang@cs.ioc.ee +Maintainer: wolfgang-it@jeltsch.info Stability: provisional -Homepage: http://grapefruit-project.org/ -Package-URL: http://hackage.haskell.org/packages/archive/grapefruit-ui-gtk/0.1.0.5/grapefruit-ui-gtk-0.1.0.5.tar.gz +Homepage: https://grapefruit-project.org/ +Package-URL: https://hackage.haskell.org/package/grapefruit-ui-gtk-0.1.0.6/grapefruit-ui-gtk-0.1.0.6.tar.gz Synopsis: GTK+-based backend for declarative user interface programming Description: Grapefruit is a library for Functional Reactive Programming (FRP) with a focus on user interfaces. FRP makes it possible to @@ -20,12 +20,16 @@ . This package contains the GTK+-based user interface backend. Category: FRP, Reactivity, GUI, User Interfaces -Tested-With: GHC == 7.6.3 +Tested-With: GHC == 8.0.1 +Source-Repository head + Type: darcs + Location: http://hub.darcs.net/jeltsch/grapefruit + Source-Repository this Type: darcs - Location: http://darcs.grapefruit-project.org/monolithic/0.1 - Tag: grapefruit-0.1.0.5 + Location: http://hub.darcs.net/jeltsch/grapefruit + Tag: grapefruit-0.1.0.6 Library Build-Depends: base >= 3.0 && < 5, @@ -35,8 +39,9 @@ grapefruit-frp >= 0.1 && < 0.2, grapefruit-records >= 0.1 && < 0.2, grapefruit-ui >= 0.1 && < 0.2, - glib >= 0.9.13 && < 0.14, - gtk >= 0.9.13 && < 0.14 + glib >= 0.13 && < 0.14, + gtk3 >= 0.14 && < 0.15, + transformers >= 0.5 && < 1 Extensions: Arrows ExistentialQuantification FlexibleContexts diff --git a/src/Graphics/UI/Grapefruit/GTK.hs b/src/Graphics/UI/Grapefruit/GTK.hs --- a/src/Graphics/UI/Grapefruit/GTK.hs +++ b/src/Graphics/UI/Grapefruit/GTK.hs @@ -16,8 +16,9 @@ import Prelude hiding (sequence_, mapM_) -- Control - import Control.Monad as Monad hiding (sequence_, mapM_) - import Control.Arrow as Arrow + import Control.Monad as Monad hiding (sequence_, mapM_) + import Control.Monad.Trans.Class as MonadTrans + import Control.Arrow as Arrow -- Data import Data.Foldable as Foldable @@ -90,13 +91,13 @@ pushButton = widgetBrick Gtk.buttonNew Gtk.toWidget (X :& Text := attrConsumer Gtk.buttonLabel) - (X :& Push := eventProducer Gtk.onPressed) + (X :& Push := eventProducer Gtk.buttonActivated) lineEditor = widgetBrick Gtk.entryNew Gtk.toWidget X (X :& Content := attrEventProducer Gtk.entryText - Gtk.onEditableChanged) + Gtk.editableChanged) box orientation = widgetBox (case orientation of Horizontal -> newGtkBox Gtk.hBoxNew @@ -110,11 +111,20 @@ Gtk.toWindow Gtk.containerAdd (X :& Title := attrConsumer Gtk.windowTitle) - (X :& Closure := eventProducer Gtk.onDestroy) + (X :& Closure := eventProducer plainDeleteEvent) newGtkBox :: (Gtk.BoxClass gtkBox) => (Bool -> Int -> IO gtkBox) -> IO Gtk.Box newGtkBox rawNewGtkBox = fmap Gtk.toBox (rawNewGtkBox False 0) + plainDeleteEvent :: Gtk.WidgetClass self => Gtk.Signal self (IO ()) + plainDeleteEvent = Gtk.Signal impl' where + + impl' bool object handler = impl bool object handler' where + + handler' = lift handler >> return False + + Gtk.Signal impl = Gtk.deleteEvent + instance ContainerUIBackend GTK where listView = listViewBrick id id @@ -330,7 +340,7 @@ let actualProducer = readEventProducer (readSelection gtkListStore) - Gtk.onSelectionChanged + Gtk.treeSelectionSelectionChanged gtkTreeSelection Signal.produce $ actualProducer -<< () @@ -486,15 +496,13 @@ -- |Constructs a producer of discrete signals that represent sequences of Gtk2Hs events. eventProducer :: (Glib.GObjectClass gObject) - => (gObject -> IO () -> IO (Glib.ConnectId gObject)) - {-^ - an @on/EventType/@ function of Gtk2Hs, representing a certain kind of - event - -} + => Gtk.Signal gObject (IO ()) + -- ^a Gtk2Hs signal -> gObject -- ^a Gtk2Hs widget which provides the events -> Producer DSignal () - eventProducer onEvent gObject = DSignal.producer (register onEvent gObject . ($ ())) + eventProducer gtkSignal gObject = DSignal.producer + (register (flip Gtk.on gtkSignal) gObject . ($ ())) {-| Constructs a producer of segmented signals whose values can be read with a certain I/O @@ -503,17 +511,14 @@ readEventProducer :: (Glib.GObjectClass gObject) => (gObject -> IO val) -- ^an action which provides the current value of the produced signal - -> (gObject -> IO () -> IO (Glib.ConnectId gObject)) - {-^ - an @on/EventType/@ function of Gtk2Hs whose corresponding events mark - the update points of the produced signal except the update point at the - beginning of the era - -} + -> Gtk.Signal gObject (IO ()) + -- ^a Gtk2Hs signal -> gObject -- ^a Gtk2Hs widget -> Producer SSignal val - readEventProducer readVal onEvent gObject = SSignal.producer (readVal gObject) - (register onEvent gObject) + readEventProducer readVal gtkSignal gObject = SSignal.producer + (readVal gObject) + (register (flip Gtk.on gtkSignal) gObject) {-| Constructs a producer of segmented signals that reflect a Gtk2Hs attribute and are updated @@ -522,12 +527,8 @@ attrEventProducer :: (Glib.GObjectClass gObject) => Glib.ReadWriteAttr gObject readVal writeVal -- ^a Gtk2Hs attribute providing the values of the produced signal - -> (gObject -> IO () -> IO (Glib.ConnectId gObject)) - {-^ - an @on/EventType/@ function of Gtk2Hs whose corresponding events mark - the update points of the produced signal except the update point at the - beginning of the era - -} + -> Gtk.Signal gObject (IO ()) + -- ^a Gtk2Hs signal -> gObject -- ^a Gtk2Hs widget -> Producer SSignal readVal