Menu
▾
▴
gtk2hs-commit — Mailing list for Darcs commit messages.
You can subscribe to this list here.
| 2003 |
Jan
|
Feb
|
Mar
|
Apr
|
May
(4) |
Jun
|
Jul
(68) |
Aug
(4) |
Sep
|
Oct
(23) |
Nov
(95) |
Dec
(9) |
|---|---|---|---|---|---|---|---|---|---|---|---|---|
| 2004 |
Jan
(3) |
Feb
|
Mar
|
Apr
(51) |
May
(81) |
Jun
(2) |
Jul
(86) |
Aug
(143) |
Sep
(3) |
Oct
(31) |
Nov
(63) |
Dec
(90) |
| 2005 |
Jan
(277) |
Feb
(157) |
Mar
(99) |
Apr
(195) |
May
(151) |
Jun
(148) |
Jul
(98) |
Aug
(123) |
Sep
(20) |
Oct
(174) |
Nov
(155) |
Dec
(26) |
| 2006 |
Jan
(51) |
Feb
(19) |
Mar
(16) |
Apr
(12) |
May
(5) |
Jun
|
Jul
(11) |
Aug
(7) |
Sep
(10) |
Oct
(31) |
Nov
(174) |
Dec
(56) |
| 2007 |
Jan
(45) |
Feb
(52) |
Mar
(10) |
Apr
(5) |
May
(47) |
Jun
(16) |
Jul
(80) |
Aug
(29) |
Sep
(14) |
Oct
(59) |
Nov
(46) |
Dec
(16) |
| 2008 |
Jan
(10) |
Feb
(1) |
Mar
|
Apr
|
May
(49) |
Jun
(26) |
Jul
(8) |
Aug
(4) |
Sep
(25) |
Oct
(53) |
Nov
(9) |
Dec
(1) |
| 2009 |
Jan
(66) |
Feb
(11) |
Mar
(1) |
Apr
(14) |
May
(8) |
Jun
(1) |
Jul
(2) |
Aug
(2) |
Sep
(9) |
Oct
(23) |
Nov
(35) |
Dec
|
| 2010 |
Jan
(7) |
Feb
(2) |
Mar
(39) |
Apr
(19) |
May
(161) |
Jun
(19) |
Jul
(32) |
Aug
(65) |
Sep
(113) |
Oct
(120) |
Nov
(2) |
Dec
|
| 2012 |
Jan
|
Feb
(5) |
Mar
(4) |
Apr
(7) |
May
(9) |
Jun
(14) |
Jul
(1) |
Aug
|
Sep
(1) |
Oct
(1) |
Nov
(12) |
Dec
(2) |
| 2013 |
Jan
(1) |
Feb
(17) |
Mar
(4) |
Apr
(4) |
May
(9) |
Jun
|
Jul
(8) |
Aug
|
Sep
(2) |
Oct
|
Nov
|
Dec
|
|
From: Axel S. <si...@co...> - 2010-01-21 14:14:45
|
Fri Nov 27 18:14:28 EST 2009 Duncan Coutts <du...@ha...>
* Fix documentation of layoutGetExtents
Ignore-this: 4a1178d41efc4062377e2ac83d8f585f
Crucially it now says which is the ink and logical rectangles.
Also the variable names are now consistent with their uses.
No actual change in behaviour.
hunk ./gtk/Graphics/UI/Gtk/Pango/Layout.chs.pp 699
--- | Compute the physical size of the layout.
+-- | Computes the logical and ink extents of the 'PangoLayout'.
hunk ./gtk/Graphics/UI/Gtk/Pango/Layout.chs.pp 701
--- * Computes the ink and the logical size of the 'Layout'. The
--- logical extend is used for positioning, the ink size is the smallest
--- bounding box that includes all character pixels. The ink size can be
--- smaller or larger that the logical layout.
+-- Logical extents are usually what you want for positioning things. Note that
+-- both extents may have non-zero x and y. You may want to use those to offset
+-- where you render the layout. Not doing that is a very typical bug that
+-- shows up as right-to-left layouts not being correctly positioned in a
+-- layout with a set width.
hunk ./gtk/Graphics/UI/Gtk/Pango/Layout.chs.pp 707
-layoutGetExtents :: PangoLayout -> IO (PangoRectangle, PangoRectangle)
+-- Layout coordinates begin at the top left corner of the layout.
+--
+layoutGetExtents :: PangoLayout
+ -> IO (PangoRectangle, PangoRectangle) -- ^ @(ink, logical)@
hunk ./gtk/Graphics/UI/Gtk/Pango/Layout.chs.pp 712
- alloca $ \logPtr -> alloca $ \inkPtr -> do
- {#call unsafe layout_get_extents#} pl (castPtr logPtr) (castPtr inkPtr)
- log <- peek logPtr
- ink <- peek inkPtr
- return (fromRect log, fromRect ink)
+ alloca $ \inkPtr ->
+ alloca $ \logPtr -> do
+ {#call unsafe layout_get_extents#} pl (castPtr inkPtr) (castPtr logPtr)
+ log <- peek inkPtr
+ ink <- peek logPtr
+ return (fromRect ink, fromRect log)
|
|
From: Axel S. <si...@co...> - 2010-01-21 14:14:26
|
Thu Dec 10 12:29:42 EST 2009 Duncan Coutts <du...@ha...>
* Handle installed package ids for ghc-6.12
Ignore-this: 938eebcca1bc9f44581144e02d0237f5
hunk ./acinclude.m4 101
- $2=$(for pkg in ${C} ; do echo "${pkg}" | sed -e 's/^[[A-Za-z0-9-]]*-\([[0-9.]]*\)$/\1/' ; done | sort -r -n | head -n1)
- AC_MSG_RESULT([yes, version $$2])
+ VER=$(for pkg in ${C} ; do echo "${pkg}" | sed -e 's/^[[A-Za-z0-9-]]*-\([[0-9.]]*\)$/\1/' ; done | sort -r -n | head -n1)
+ $2=${VER}
+ if test "${GHC_VERSION_612}" = "yes"; then
+ $3=$(${GHCPKG} field $1-${VER} id | cut -d' ' -f2)
+ else
+ $3=$1-${VER}
+ fi
+ AC_MSG_RESULT([yes, version ${VER}])
hunk ./cairo/cairo.package.conf.in 3
+id: cairo-@PACKAGE_VERSION@
hunk ./cairo/cairo.package.conf.in 19
-depends: base-@PKG_BASE_VERSION@ mtl-@PKG_MTL_VERSION@ glib-@PACKAGE_VERSION@ @CAIRO_SPLITBASE_DEPENDS@
+depends: @PKG_BASE_ID@ @PKG_MTL_ID@ glib-@PACKAGE_VERSION@ @CAIRO_SPLITBASE_DEPENDS@
hunk ./configure.ac 124
+GTKHS_PROG_CHECK_VERSION($GHC_VERSION, -ge, 6.12,
+ GHC_VERSION_612=yes, GHC_VERSION_612=no)
+
hunk ./configure.ac 240
+m4_pattern_allow([^PKG_])
hunk ./configure.ac 243
-GHC_PKG_CHECK(base,PKG_BASE_VERSION)
-GTKHS_PROG_CHECK_VERSION($PKG_BASE_VERSION, -ge, 4.0,
-AC_DEFINE(HAVE_NEW_CONTROL_EXCEPTION,[1],[Define if you have the new Control.Exception module (from GHC 6.10)]))
-GHC_PKG_CHECK(haskell98,PKG_HASKELL98_VERSION)
-GHC_PKG_CHECK(mtl,PKG_MTL_VERSION)
+GHC_PKG_CHECK(base, [PKG_BASE_VERSION], [PKG_BASE_ID])
+GHC_PKG_CHECK(haskell98, [PKG_HASKELL98_VERSION], [PKG_HASKELL98_ID])
+GHC_PKG_CHECK(mtl, [PKG_MTL_VERSION], [PKG_MTL_ID])
+if test "$HAVE_SPLIT_BASE" = "yes"; then
+ GHC_PKG_CHECK(bytestring, [PKG_BYTESTRING_VERSION], [PKG_BYTESTRING_ID])
+ GHC_PKG_CHECK(containers, [PKG_CONTAINERS_VERSION], [PKG_CONTAINERS_ID])
+ GHC_PKG_CHECK(array, [PKG_ARRAY_VERSION], [PKG_ARRAY_ID])
+ GHC_PKG_CHECK(old-time, [PKG_OLDTIME_VERSION], [PKG_OLDTIME_ID])
+ GHC_PKG_CHECK(pretty, [PKG_PRETTY_VERSION], [HSPKG_PRETTY_ID])
+
+ CAIRO_SPLITBASE_DEPENDS="${PKG_BYTESTRING_ID} ${PKG_ARRAY_ID}"
+ GTK_SPLITBASE_DEPENDS="${PKG_CONTAINERS_ID} ${PKG_ARRAY_ID}"
+ SOEGTK_SPLITBASE_DEPENDS="${PKG_OLDTIME_ID}"
+ GNOMEVFS_SPLITBASE_DEPENDS="${PKG_BYTESTRING_ID}"
+ GSTREAMER_SPLITBASE_DEPENDS="${PKG_BYTESTRING_ID}"
+fi
hunk ./configure.ac 262
-if test "$HAVE_SPLIT_BASE" = "yes"; then
- GHC_PKG_CHECK(bytestring,PKG_BYTESTRING_VERSION)
- GHC_PKG_CHECK(containers, [PKG_CONTAINERS_VERSION])
- GHC_PKG_CHECK(array, [PKG_ARRAY_VERSION])
- CAIRO_SPLITBASE_DEPENDS="bytestring-${PKG_BYTESTRING_VERSION} array-${PKG_ARRAY_VERSION}"
- GHC_PKG_CHECK(old-time, [PKG_OLDTIME_VERSION])
- GHC_PKG_CHECK(pretty, [PKG_PRETTY_VERSION])
- GTK_SPLITBASE_DEPENDS="containers-${PKG_CONTAINERS_VERSION} array-${PKG_ARRAY_VERSION}"
- SOEGTK_SPLITBASE_DEPENDS="old-time-${PKG_OLDTIME_VERSION}"
- GNOMEVFS_SPLITBASE_DEPENDS="bytestring-${PKG_BYTESTRING_VERSION}"
- GSTREAMER_SPLITBASE_DEPENDS="bytestring-${PKG_BYTESTRING_VERSION}"
-fi
hunk ./configure.ac 267
+
+AC_SUBST(PKG_BASE_ID)
+AC_SUBST(PKG_HASKELL98_ID)
+AC_SUBST(PKG_MTL_ID)
+AC_SUBST(PKG_BYTESTRING_ID)
+AC_SUBST(PKG_CONTAINERS_ID)
+AC_SUBST(PKG_ARRAY_ID)
+AC_SUBST(PKG_OLDTIME_ID)
+AC_SUBST(PKG_PRETTY_ID)
+
hunk ./configure.ac 283
+GTKHS_PROG_CHECK_VERSION($PKG_BASE_VERSION, -ge, 4.0,
+AC_DEFINE(HAVE_NEW_CONTROL_EXCEPTION,[1],
+ [Define if you have the new Control.Exception module (from GHC 6.10)]))
+
hunk ./gconf/gconf.package.conf.in 3
+id: gconf-@PACKAGE_VERSION@
hunk ./gconf/gconf.package.conf.in 17
-depends: base-@PKG_BASE_VERSION@ glib-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ glib-@PACKAGE_VERSION@
hunk ./gio/gio.package.conf.in 3
+id: gio-@PACKAGE_VERSION@
hunk ./gio/gio.package.conf.in 17
-depends: base-@PKG_BASE_VERSION@ glib-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ glib-@PACKAGE_VERSION@
hunk ./glade/glade.package.conf.in 3
+id: glade-@PACKAGE_VERSION@
hunk ./glade/glade.package.conf.in 17
-depends: base-@PKG_BASE_VERSION@ gtk-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ gtk-@PACKAGE_VERSION@
hunk ./glib/glib.package.conf.in 3
+id: glib-@PACKAGE_VERSION@
hunk ./glib/glib.package.conf.in 17
-depends: base-@PKG_BASE_VERSION@
+depends: @PKG_BASE_ID@
hunk ./gnomevfs/gnomevfs.package.conf.in 3
+id: gnomevfs-@PACKAGE_VERSION@
hunk ./gnomevfs/gnomevfs.package.conf.in 17
-depends: glib-@PACKAGE_VERSION@ mtl-@PKG_MTL_VERSION@ @GNOMEVFS_SPLITBASE_DEPENDS@
+depends: glib-@PACKAGE_VERSION@ @PKG_MTL_ID@ @GNOMEVFS_SPLITBASE_DEPENDS@
hunk ./gstreamer/gstreamer.package.conf.in 3
+id: gstreamer-@PACKAGE_VERSION@
hunk ./gstreamer/gstreamer.package.conf.in 17
-depends: glib-@PACKAGE_VERSION@ mtl-@PKG_MTL_VERSION@ @GSTREAMER_SPLITBASE_DEPENDS@
+depends: glib-@PACKAGE_VERSION@ @PKG_MTL_ID@ @GSTREAMER_SPLITBASE_DEPENDS@
hunk ./gtk/gtk.package.conf.in 3
+id: gtk-@PACKAGE_VERSION@
hunk ./gtk/gtk.package.conf.in 17
-depends: base-@PKG_BASE_VERSION@ mtl-@PKG_MTL_VERSION@ glib-@PACKAGE_VERSION@ @GTK_CAIRO_DEPEND@ @GTK_SPLITBASE_DEPENDS@
+depends: @PKG_BASE_ID@ @PKG_MTL_ID@ glib-@PACKAGE_VERSION@ @GTK_CAIRO_DEPEND@ @GTK_SPLITBASE_DEPENDS@
hunk ./gtkglext/gtkglext.package.conf.in 3
+id: gtkglext-@PACKAGE_VERSION@
hunk ./gtkglext/gtkglext.package.conf.in 17
-depends: base-@PKG_BASE_VERSION@ gtk-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ gtk-@PACKAGE_VERSION@
hunk ./gtksourceview2/gtksourceview2.package.conf.in 3
+id: gtksourceview2-@PACKAGE_VERSION@
hunk ./gtksourceview2/gtksourceview2.package.conf.in 26
-depends: base-@PKG_BASE_VERSION@ gtk-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ gtk-@PACKAGE_VERSION@
hunk ./mozembed/mozembed.package.conf.in 3
+id: mozembed-@PACKAGE_VERSION@
hunk ./mozembed/mozembed.package.conf.in 17
-depends: base-@PKG_BASE_VERSION@ gtk-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ gtk-@PACKAGE_VERSION@
hunk ./soegtk/soegtk.package.conf.in 3
+id: soegtk-@PACKAGE_VERSION@
hunk ./soegtk/soegtk.package.conf.in 14
-depends: base-@PKG_BASE_VERSION@ mtl-@PKG_MTL_VERSION@ gtk-@PACKAGE_VERSION@ @GTK_CAIRO_DEPEND@ @SOEGTK_SPLITBASE_DEPENDS@
+depends: @PKG_BASE_ID@ @PKG_MTL_ID@ gtk-@PACKAGE_VERSION@ @GTK_CAIRO_DEPEND@ @SOEGTK_SPLITBASE_DEPENDS@
hunk ./sourceview/sourceview.package.conf.in 3
+id: sourceview-@PACKAGE_VERSION@
hunk ./sourceview/sourceview.package.conf.in 20
-depends: base-@PKG_BASE_VERSION@ gtk-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ gtk-@PACKAGE_VERSION@
hunk ./svgcairo/svgcairo.package.conf.in 3
+id: svgcairo-@PACKAGE_VERSION@
hunk ./svgcairo/svgcairo.package.conf.in 19
-depends: base-@PKG_BASE_VERSION@ mtl-@PKG_MTL_VERSION@ glib-@PACKAGE_VERSION@ cairo-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ @PKG_MTL_ID@ glib-@PACKAGE_VERSION@ cairo-@PACKAGE_VERSION@
hunk ./vte/vte.package.conf.in 3
+id: vte-@PACKAGE_VERSION@
hunk ./vte/vte.package.conf.in 17
-depends: base-@PKG_BASE_VERSION@ gtk-@PACKAGE_VERSION@
+depends: @PKG_BASE_ID@ gtk-@PACKAGE_VERSION@
|
|
From: Axel S. <si...@co...> - 2010-01-21 14:14:11
|
Thu Dec 10 13:10:07 EST 2009 Duncan Coutts <du...@ha...>
* Make c2hs read text files in latin1 encoding
Ignore-this: 9edf2d4a79a63f95d20f435cad9e1303
The c2hs lexer cannot cope with code points over 255.
Fixes the ghc-6.12 build problem where it consumes all memory.
hunk ./tools/c2hs/base/state/CIO.hs 1
+{-# LANGUAGE CPP #-}
+{-# OPTIONS_GHC -cpp #-}
hunk ./tools/c2hs/base/state/CIO.hs 78
+#if __GLASGOW_HASKELL__ >= 612
+import System.IO (hSetEncoding, latin1)
+#endif
hunk ./tools/c2hs/base/state/CIO.hs 90
-openFileCIO p m = liftIO (openFile p m)
+openFileCIO p m = liftIO $ do
+ hnd <- openFile p m
+#if __GLASGOW_HASKELL__ >= 612
+ hSetEncoding hnd latin1
+#endif
+ return hnd
hunk ./tools/c2hs/base/state/CIO.hs 116
-writeFileCIO fname contents = liftIO (writeFile fname contents)
+writeFileCIO fname contents = do
+ hnd <- openFileCIO fname WriteMode
+ hPutStrCIO hnd contents
+ hCloseCIO hnd
hunk ./tools/c2hs/base/state/CIO.hs 122
-readFileCIO fname = liftIO (readFile fname)
+readFileCIO fname = do
+ hnd <- openFileCIO fname ReadMode
+ liftIO (hGetContents hnd)
|
|
From: Axel S. <si...@co...> - 2010-01-21 14:14:09
|
Thu Dec 10 13:12:37 EST 2009 Duncan Coutts <du...@ha...>
* Remove leading space in FFI import names
Ignore-this: 742ed4c393cb770d5e0699030f3a4288
ghc-6.12 complains about this.
hunk ./tools/c2hs/gen/GenBind.hs 732
- "foreign import ccall " ++ safety ++ " \"" ++ header ++ " " ++ ident ++ [_$_]
+ "foreign import ccall " ++ safety ++ " \"" ++ entity ++
hunk ./tools/c2hs/gen/GenBind.hs 736
+ entity | null header = ident
+ | otherwise = header ++ " " ++ ident
|
|
From: Axel S. <si...@co...> - 2010-01-21 14:14:01
|
Thu Dec 10 13:11:44 EST 2009 Duncan Coutts <du...@ha...>
* Disable c2hs support for C long double
Ignore-this: 52ca68024ce3f3bc894cf14eb64630c6
The CLDouble type is missing in ghc-6.12, though it may return.
The Gtk+ headers do not use long double, so it's ok.
hunk ./tools/c2hs/gen/CInfo.hs 123
-size CLDoublePT = Storable.sizeOf (undefined :: CLDouble)
+--size CLDoublePT = Storable.sizeOf (undefined :: CLDouble)
hunk ./tools/c2hs/gen/CInfo.hs 148
-alignment CLDoublePT = Storable.alignment (undefined :: CLDouble)
+--alignment CLDoublePT = Storable.alignment (undefined :: CLDouble)
|
|
From: Andy S. <And...@co...> - 2009-11-26 12:36:15
|
Thu Nov 26 07:32:39 EST 2009 Andy Stewart <laz...@gm...>
* Use simpler embbeded demo replace previous one.
Ignore-this: 51d2f4d8a44bc9a63ed3ce6e7f2f25e6
hunk ./demo/embbeded/Embedded.hs 2
--- Just startup program, press 'Alt-m' to new editor, press `Alt-n` to new terminal.
--- And those plug widget (editor, terminal) running in child-process, [_$_]
--- so program won't crash when child-process throw un-catch exception.
+-- Just startup program, press 'm' to create tab with new button.
+-- Click button for hang to simulate plug hanging process, [_$_]
+-- but socket process still running, can switch to other tab. [_$_]
hunk ./demo/embbeded/Embedded.hs 14
+import Control.Concurrent
hunk ./demo/embbeded/Embedded.hs 18
-import Graphics.UI.Gtk.Vte.Vte
hunk ./demo/embbeded/Embedded.hs 20
-data PlugType = PlugEditor
- | PlugTerminal
- deriving (Eq, Ord, Show, Read)
-
hunk ./demo/embbeded/Embedded.hs 29
- case length args of
- -- Entry socket main when no arguments.
- 0 -> socketMain [_$_]
-
+ case args of
hunk ./demo/embbeded/Embedded.hs 31
- 2 -> do
- let pType = read (head args) :: PlugType -- get Plug type
- id = toNativeWindowId $ read (last args) :: NativeWindowId -- get GtkSocket id
-
- plugMain id pType
- -- Otherwise just output error and exit.
- _ -> putStrLn "Wrong program arguments."
+ [id] -> plugMain (toNativeWindowId $ read id :: NativeWindowId) -- get GtkSocket id
+ -- Othersise entry socket main when no arguments.
+ _ -> socketMain [_$_]
hunk ./demo/embbeded/Embedded.hs 38
- -- Output message.
- pid <- getProcessID
- putStrLn $ "Running in socket process : " ++ show pid
-
hunk ./demo/embbeded/Embedded.hs 40
- windowFullscreen window
+ windowSetPosition window WinPosCenter
+ windowSetDefaultSize window 600 400
+ windowSetTitle window "Press `m` to new tab, press `q` exit."
hunk ./demo/embbeded/Embedded.hs 51
- keyModifier <- eventModifier
- keyName <- eventKeyName
- liftIO $ when (keyModifier == [Alt]) $ [_$_]
+ keyName <- eventKeyName
+ liftIO $ [_$_]
hunk ./demo/embbeded/Embedded.hs 54
- "m" -> forkPlugProcess notebook PlugEditor "Editor" -- create editor GtkPlug
- "n" -> forkPlugProcess notebook PlugTerminal "Terminal" -- create terminal GtkPlug
+ "m" -> do
+ -- Create new GtkSocket.
+ socket <- socketNew
+ widgetShow socket -- must show before add GtkSocekt to container
+ notebookAppendPage notebook socket "Tab" -- add to GtkSocekt notebook
+ id <- socketGetId socket -- get GtkSocket id
+
+ -- Fork process to add GtkPlug into GtkSocekt. [_$_]
+ path <- liftM2 (</>) getCurrentDirectory getProgName -- get program full path
+ forkProcess (executeFile path False [show $ fromNativeWindowId id] Nothing)
+ return ()
+ "q" -> mainQuit -- quit
hunk ./demo/embbeded/Embedded.hs 72
-plugMain :: NativeWindowId -> PlugType -> IO ()
-plugMain id PlugEditor = plugWrap id =<< createEditor
-plugMain id PlugTerminal = plugWrap id =<< createTerminal
-
--- | Fork plug process.
-forkPlugProcess :: Notebook -> PlugType -> String -> IO ()
-forkPlugProcess notebook plugType tabName = do
- -- Create new GtkSocket.
- socket <- socketNew
- widgetShow socket -- must show before add GtkSocekt to container
- notebookAppendPage notebook socket tabName -- add to GtkSocekt notebook
- id <- socketGetId socket -- get GtkSocket id
-
- -- Fork process to add GtkPlug into GtkSocekt. [_$_]
- path <- liftM2 (</>) getCurrentDirectory getProgName -- get program full path
- forkProcess (executeFile path False [show plugType, show $ fromNativeWindowId id] Nothing)
- return ()
-
--- | Plug wrap function.
-plugWrap :: WidgetClass widget => NativeWindowId -> widget -> IO ()
-plugWrap id widget = do
- -- Output message.
- pid <- getProcessID
- putStrLn $ "Running in plug process : " ++ show pid
-
- -- Create GtkPlug with GtkSocekt id.
+plugMain :: NativeWindowId -> IO ()
+plugMain id = do
hunk ./demo/embbeded/Embedded.hs 77
- -- Add widget to GtkPlug.
- scrolledWindow <- scrolledWindowNew Nothing Nothing
- scrolledWindow `containerAdd` widget
- plug `containerAdd` scrolledWindow
-
- widgetShowAll plug [_$_]
+ button <- buttonNewWithLabel "Click me to hang."
+ plug `containerAdd` button
hunk ./demo/embbeded/Embedded.hs 80
+ -- Simulate a plugin hanging to see if it blocks the outer process.
+ button `onClicked` threadDelay 5000000
+ [_$_]
+ widgetShowAll plug
+ [_$_]
hunk ./demo/embbeded/Embedded.hs 87
--- Create editor widget.
-createEditor :: IO TextView
-createEditor = textViewNew
- [_$_]
--- Create terminal widget.
-createTerminal :: IO Terminal [_$_]
-createTerminal = do
- terminal <- terminalNew
- terminalForkCommand terminal Nothing Nothing Nothing Nothing False False False
- return terminal
hunk ./demo/embbeded/Makefile 5
- $(HC) --make $< -o $@ $(HCFLAGS) -XForeignFunctionInterface
+ $(HC) --make $< -o $@ $(HCFLAGS)
|
|
From: Axel S. <si...@co...> - 2009-11-25 10:27:48
|
Wed Nov 25 05:27:01 EST 2009 Axel Simon <Axe...@en...>
* Remove debugging croft from demo.
hunk ./demo/treeList/ListText.hs 67
- putStrLn ("querying reorderability")
hunk ./demo/treeList/ListText.hs 69
- view `on` cursorChanged $ do
- putStrLn "Cursor changed"
- mapM_ (const windowNew) [0..10]
-
-
|
|
From: Axel S. <si...@co...> - 2009-11-24 22:36:06
|
Tue Nov 24 17:34:44 EST 2009 Axe...@en...
* Apply renaming to gstreamer.
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 240
--- the following mess is necessary to clean up the FunPtr after
--- busSetSyncHandler. gstreamer doesn't give us a nice way to do this
--- (such as a DestroyNotify pointer in the argument list)
--- Note: I've removed this magic since GWeakNotify had to moved out of
--- GObject since GObject can be finalized directly from the Haskell GC
--- which can (and will in the case below) callbacks into Haskell that
--- will make the program abort. We're leaking the function closure instead.
---weakNotifyQuark,
+-- See Graphics.UI.Gtk.General.Clipboard.clipboardSetWithData for an
+-- explanation of this hack.
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 243
---weakNotifyQuark = unsafePerformIO $ quarkFromString "Gtk2HS::SyncHandlerWeakNotify"
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 245
-{-
-getWeakNotify :: BusClass busT
- => busT
- -> IO (Maybe GWeakNotify)
-getWeakNotify = objectGetAttributeUnsafe weakNotifyQuark
-
-setWeakNotify :: BusClass busT
- => busT
- -> Maybe GWeakNotify
- -> IO ()
-setWeakNotify = objectSetAttribute weakNotifyQuark
--}
-
-getFunPtr :: BusClass busT
- => busT
- -> IO (Maybe {# type GstBusSyncHandler #})
-getFunPtr = objectGetAttributeUnsafe funPtrQuark
-
-setFunPtr :: BusClass busT
- => busT
- -> Maybe {# type GstBusSyncHandler #}
- -> IO ()
-setFunPtr = objectSetAttribute funPtrQuark
-
-unsetSyncHandler :: BusClass busT
- => busT
- -> IO ()
-unsetSyncHandler bus = do
- {# call bus_set_sync_handler #} (toBus bus) nullFunPtr nullPtr
-{-
- oldWeakNotifyM <- getWeakNotify bus
- case oldWeakNotifyM of
- Just oldWeakNotify -> objectWeakunref bus oldWeakNotify
- Nothing -> return ()
- setWeakNotify bus Nothing
--}
- oldFunPtrM <- getFunPtr bus
- case oldFunPtrM of
- Just oldFunPtr -> freeHaskellFunPtr oldFunPtr
- Nothing -> return ()
- setFunPtr bus Nothing
-
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 257
-busSetSyncHandler bus busSyncHandlerM = do
- objectWithLock bus $ do
- unsetSyncHandler bus
- case busSyncHandlerM of
- Just busSyncHandler ->
- do funPtr <- marshalBusSyncHandler busSyncHandler
- setFunPtr bus $ Just funPtr
-{- [_$_]
- weakNotify <- objectWeakref bus $ freeHaskellFunPtr funPtr
- setWeakNotify bus $ Just weakNotify
--}
- {# call bus_set_sync_handler #} (toBus bus) funPtr nullPtr
- Nothing ->
- return ()
+busSetSyncHandler bus Nothing = objectWithLock bus $ do
+ {#call bus_set_sync_handler #} (toBus bus) nullFunPtr nullPtr
+ {#call unsafe g_object_set_qdata#} (toGObject bus) funPtrQuark nullPtr
+busSetSyncHandler bus (Just busSyncHandler) = objectWithLock bus $ do
+ funPtr <- marshalBusSyncHandler busSyncHandler [_$_]
+ {#call bus_set_sync_handler #} (toBus bus) funPtr nullPtr
+ {#call unsafe g_object_set_qdata_full#} (toGObject bus) funPtrQuark
+ (castFunPtrToPtr funPtr) destroyFunPtr
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 270
-busUseSyncSignalHandler bus = do
- objectWithLock bus $ do
- unsetSyncHandler bus
- {# call bus_set_sync_handler #} (toBus bus) cBusSyncSignalHandlerPtr nullPtr
+busUseSyncSignalHandler bus = objectWithLock bus $ do
+ {# call bus_set_sync_handler #} (toBus bus) cBusSyncSignalHandlerPtr nullPtr
+ {#call unsafe g_object_set_qdata#} (toGObject bus) funPtrQuark nullPtr
+
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 318
- destroyNotify <- mkFunPtrDestroyNotify busFuncPtr
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 324
- destroyNotify
+ destroyFunPtr
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Index.chs 61
-{#import System.Glib.GObject#} (mkFunPtrDestroyNotify)
+{#import System.Glib.GObject#} (destroyFunPtr)
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Index.chs 142
- destroyNotify <- mkFunPtrDestroyNotify cFilter
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Index.chs 143
- (castFunPtrToPtr cFilter) destroyNotify
+ (castFunPtrToPtr cFilter) destroyFunPtr
|
|
From: Axel S. <si...@co...> - 2009-11-24 22:02:09
|
Tue Nov 24 16:57:44 EST 2009 Axel Simon <Axe...@en...>
* Get rid of mkFunPtrDestroyNotify.
This is a cleanup patch towards having all function that pass Haskell function
closures to C use cleanup functions that are mere C addresses. GObject now
no longer exports mkFunPtrDestroyNotify but two C function addresses that
free function and stable pointers, resp. This patch also fixes the
memory management in Clipboard which is a beast.
hunk ./glib/System/Glib/GObject.chs.pp 48
- mkFunPtrDestroyNotify,
+ destroyFunPtr,
+ destroyStablePtr,
hunk ./glib/System/Glib/GObject.chs.pp 143
--- it is no longer required. This function constructs a DestroyNotify function
--- pointer which when called from C land will free the given Haskell function
--- pointer (and itself).
-mkFunPtrDestroyNotify :: FunPtr a -> IO DestroyNotify
-mkFunPtrDestroyNotify hPtr = return freeCallbackFunPtr
-
-foreign import ccall unsafe "&freeHaskellFunctionPtr" freeCallbackFunPtr :: DestroyNotify
-
+-- it is no longer required. This constants is an address of a functions in
+-- C land that will free a function pointer.
+foreign import ccall unsafe "&freeHaskellFunctionPtr" destroyFunPtr :: DestroyNotify
hunk ./glib/System/Glib/GObject.chs.pp 172
+-- | The address of a function freeing a 'StablePtr'. See 'destroyFunPtr'.
+foreign import ccall unsafe "&hs_free_stable_ptr" destroyStablePtr :: DestroyNotify
+
hunk ./glib/System/Glib/GObject.chs.pp 182
- funPtrContainer <- newIORef nullFunPtr
- destrFunPtr <- mkDestroyNotifyPtr $ do
- freeStablePtr sPtr
- funPtr <- readIORef funPtrContainer
- freeHaskellFunPtr funPtr
- writeIORef funPtrContainer destrFunPtr
hunk ./glib/System/Glib/GObject.chs.pp 183
- destrFunPtr
+ destroyStablePtr
hunk ./glib/System/Glib/MainLoop.chs.pp 67
-import System.Glib.GObject (DestroyNotify, mkFunPtrDestroyNotify)
+import System.Glib.GObject (DestroyNotify, destroyFunPtr)
hunk ./glib/System/Glib/MainLoop.chs.pp 82
- dPtr <- mkFunPtrDestroyNotify funPtr
- return (funPtr, dPtr)
+ return (funPtr, destroyFunPtr)
hunk ./glib/System/Glib/MainLoop.chs.pp 181
- dPtr <- mkFunPtrDestroyNotify funPtr
hunk ./glib/System/Glib/MainLoop.chs.pp 188
- dPtr
+ destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs.pp 116
- makeNewGObject, mkFunPtrDestroyNotify)
+ makeNewGObject, destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs.pp 365
- notifyPtr <- mkFunPtrDestroyNotify funcPtr
hunk ./gtk/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs.pp 369
- notifyPtr
+ destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 144
- makeNewGObject, mkFunPtrDestroyNotify)
+ makeNewGObject, destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 238
- dPtr <- mkFunPtrDestroyNotify hPtr
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 239
- (castFunPtr hPtr) (castFunPtrToPtr hPtr) dPtr
+ (castFunPtr hPtr) (castFunPtrToPtr hPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 111
+{-
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 115
+-}
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 226
+-- The memory management of the ClipboardGetFunc and ClipboardClearFunc sucks badly
+-- in that there is no consistent way in which the latter could free the function
+-- closure of the former, since it is *not* called when the data of the same
+-- object is changed. What we do is that we store the function pointers as attributes
+-- of the Clipboard. Overwriting or finalizing these attributes will call their
+-- destructors and thereby free them. Thus, by setting these attributes each time we
+-- install new data functions, we cuningly finalized the previous closures. Hooray.
+
+{-# NOINLINE getFuncQuark #-} [_$_]
+getFuncQuark :: Quark
+getFuncQuark = unsafePerformIO $ quarkFromString "hsClipboardGetFuncClosure"
+
+{-# NOINLINE clearFuncQuark #-} [_$_]
+clearFuncQuark :: Quark
+clearFuncQuark = unsafePerformIO $ quarkFromString "hsClipboardClearFuncClosure"
+
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 254
- -- 'Graphics.UI.Gtk.General.Selection.selectionDataSet'.
+ -- 'selectionDataSet'.
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 259
- -- data succeeded. If setting the clipboard data
- -- failed the provided callback functions will be
- -- ignored.
+ -- data succeeded.
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 263
- dFunPtr <- mkFunPtrClearFunc clearFunc gFunPtr
- withTargetEntries targets $ \nTargets targets ->
+ cFunPtr <- mkClipboardClearFunc
+ (\_ _ -> clearFunc)
+ res <- withTargetEntries targets $ \nTargets targets ->
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 272
- dFunPtr
+ cFunPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 274
+ {#call unsafe g_object_set_qdata_full#} (toGObject self) getFuncQuark
+ (castFunPtrToPtr gFunPtr) destroyFunPtr
+ {#call unsafe g_object_set_qdata_full#} (toGObject self) clearFuncQuark
+ (castFunPtrToPtr cFunPtr) destroyFunPtr
+ return res
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 281
+{#pointer ClipboardClearFunc#}
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 286
--- For reasons unknown, the two surrounding clipboard functions use a
--- non-standard finaliser. It might be that it is of interest to the user
--- when data is not needed anymore, thus we provide an IO action.
-mkFunPtrClearFunc :: IO () -> FunPtr a ->
- IO (FunPtr (Ptr Clipboard -> Ptr () -> IO ()))
-mkFunPtrClearFunc clearFunc hPtr = do
- dRef <- newIORef nullFunPtr
- dPtr <- mkClearFuncPtr $ do
- clearFunc
- freeHaskellFunPtr hPtr
- dPtr <- readIORef dRef
- freeHaskellFunPtr dPtr
- writeIORef dRef dPtr
- return dPtr
-
-foreign import ccall "wrapper" mkClearFuncPtr :: IO () -> [_$_]
- IO (FunPtr (Ptr Clipboard -> Ptr () -> IO ()))
+foreign import ccall "wrapper" mkClipboardClearFunc ::
+ (Ptr Clipboard -> Ptr () -> IO ()) -> IO ClipboardClearFunc
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 295
--- a 'GObject' is passed in. If this function is called repeatedly with
--- the same 'GObject' then the @clearFunc@ is not called each time.
+-- a 'GObject' is passed in.
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 304
- -- 'Graphics.UI.Gtk.General.Selection.selectionDataSet'.
+ -- 'selectionDataSet'.
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 316
- dFunPtr <- mkFunPtrClearFunc clearFunc gFunPtr
- withTargetEntries targets $ \nTargets targets ->
+ cFunPtr <- mkClipboardClearFunc
+ (\_ _ -> clearFunc)
+ res <- withTargetEntries targets $ \nTargets targets ->
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 325
- dFunPtr
+ cFunPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 327
+ {#call unsafe g_object_set_qdata_full#} (toGObject self) getFuncQuark
+ (castFunPtrToPtr gFunPtr) destroyFunPtr
+ {#call unsafe g_object_set_qdata_full#} (toGObject self) clearFuncQuark
+ (castFunPtrToPtr cFunPtr) destroyFunPtr
+ return res
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 347
-
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 401
- -- 'Graphics.UI.Gtk.General.Selection.selectionDataIsValid' returns @False@.
+ -- 'selectionDataIsValid' returns @False@.
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 440
- cbRef <- newIORef nullFunPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 442
- cbPtr <- readIORef cbRef
- freeHaskellFunPtr cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 445
- writeIORef cbRef cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 449
+ freeHaskellFunPtr cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 476
- cbRef <- newIORef nullFunPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 478
- cbPtr <- readIORef cbRef
- freeHaskellFunPtr cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 480
- writeIORef cbRef cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 484
+ freeHaskellFunPtr cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 510
- cbRef <- newIORef nullFunPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 512
- cbPtr <- readIORef cbRef
- freeHaskellFunPtr cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 515
- writeIORef cbRef cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 519
+ freeHaskellFunPtr cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 546
- cbRef <- newIORef nullFunPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 548
- cbPtr <- readIORef cbRef
- freeHaskellFunPtr cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 552
- writeIORef cbRef cbPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 557
+ freeHaskellFunPtr cbPtr
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 159
- mkFunPtrDestroyNotify,
+ destroyFunPtr,
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 500
- desPtr <- mkFunPtrDestroyNotify funPtr
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 501
- (toComboBox self) funPtr (castFunPtrToPtr funPtr) desPtr
+ (toComboBox self) funPtr (castFunPtrToPtr funPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/CellLayout.chs.pp 73
-import System.Glib.GObject (mkFunPtrDestroyNotify)
+import System.Glib.GObject (destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/ModelView/CellLayout.chs.pp 236
- destroy <- mkFunPtrDestroyNotify fPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/CellLayout.chs.pp 237
- (toCellRenderer cell) fPtr (castFunPtrToPtr fPtr) destroy
+ (toCellRenderer cell) fPtr (castFunPtrToPtr fPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModelFilter.chs.pp 160
- destroyPtr <- mkFunPtrDestroyNotify funcPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModelFilter.chs.pp 161
- (toTreeModelFilter self) funcPtr (castFunPtrToPtr funcPtr) destroyPtr
+ (toTreeModelFilter self) funcPtr (castFunPtrToPtr funcPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs.pp 106
-import System.Glib.GObject (mkFunPtrDestroyNotify)
+import System.Glib.GObject (destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs.pp 152
- dPtr <- mkFunPtrDestroyNotify fPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs.pp 156
- dPtr
+ destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSortable.chs.pp 95
-import System.Glib.GObject (mkFunPtrDestroyNotify)
+import System.Glib.GObject (destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSortable.chs.pp 163
- dPtr <- mkFunPtrDestroyNotify fPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSortable.chs.pp 166
- fPtr (castFunPtrToPtr fPtr) dPtr
+ fPtr (castFunPtrToPtr fPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSortable.chs.pp 194
- dPtr <- mkFunPtrDestroyNotify fPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSortable.chs.pp 196
- fPtr (castFunPtrToPtr fPtr) dPtr
+ fPtr (castFunPtrToPtr fPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 250
- mkFunPtrDestroyNotify)
+ destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 557
- dPtr <- mkFunPtrDestroyNotify fPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 560
- (castFunPtrToPtr fPtr) dPtr
+ (castFunPtrToPtr fPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 1071
- dPtr <- mkFunPtrDestroyNotify fPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 1072
- (castFunPtrToPtr fPtr) dPtr
+ (castFunPtrToPtr fPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 1322
- destroyPtr <- mkFunPtrDestroyNotify funcPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 1323
- (toTreeView self) funcPtr (castFunPtrToPtr funcPtr) destroyPtr
+ (toTreeView self) funcPtr (castFunPtrToPtr funcPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/Selectors/FileFilter.chs.pp 86
-import System.Glib.GObject (mkFunPtrDestroyNotify)
+import System.Glib.GObject (DestroyNotify, destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/Selectors/FileFilter.chs.pp 186
- dPtr <- mkFunPtrDestroyNotify hPtr
hunk ./gtk/Graphics/UI/Gtk/Selectors/FileFilter.chs.pp 191
- dPtr
-
-{#pointer GDestroyNotify#}
+ destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/Selectors/FileFilter.chs.pp 195
-foreign import ccall "wrapper" mkDestructor :: IO () -> IO GDestroyNotify
-
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeSelection.chs.pp 109
-import System.Glib.GObject (mkFunPtrDestroyNotify)
+import System.Glib.GObject (destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeSelection.chs.pp 156
- dPtr <- mkFunPtrDestroyNotify fPtr
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeSelection.chs.pp 159
- nullPtr
- dPtr
+ (castFunPtrToPtr fPtr)
+ destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp 199
-import System.Glib.GObject (makeNewGObject, mkFunPtrDestroyNotify)
+import System.Glib.GObject (makeNewGObject, destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp 1030
- dPtr <- mkFunPtrDestroyNotify fPtr
hunk ./gtk/Graphics/UI/Gtk/TreeList/TreeView.chs.pp 1031
- nullPtr dPtr
+ (castFunPtrToPtr fPtr) destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/Windows/AboutDialog.chs.pp 147
-import System.Glib.GObject (makeNewGObject, mkFunPtrDestroyNotify)
+import System.Glib.GObject (makeNewGObject, destroyFunPtr)
hunk ./gtk/Graphics/UI/Gtk/Windows/AboutDialog.chs.pp 445
- destroyPtr <- mkFunPtrDestroyNotify funcPtr
hunk ./gtk/Graphics/UI/Gtk/Windows/AboutDialog.chs.pp 448
- destroyPtr
+ destroyFunPtr
hunk ./gtk/Graphics/UI/Gtk/Windows/AboutDialog.chs.pp 463
- destroyPtr <- mkFunPtrDestroyNotify funcPtr
hunk ./gtk/Graphics/UI/Gtk/Windows/AboutDialog.chs.pp 466
- destroyPtr
+ destroyFunPtr
|
|
From: Andy S. <And...@co...> - 2009-11-23 03:15:05
|
Sun Nov 22 22:11:43 EST 2009 Andy Stewart <laz...@gm...>
* Use Gdk.EventM replace Gdk.Events, and make demo simpler.
Ignore-this: b20fa6438a839a94aa5757eabe07e90c
hunk ./demo/embbeded/Embedded.hs 13
-
-import Event
-import Key
+import Control.Monad.Trans
hunk ./demo/embbeded/Embedded.hs 18
-
-import qualified Graphics.UI.Gtk.Gdk.Events as E
+import Graphics.UI.Gtk.Gdk.EventM
hunk ./demo/embbeded/Embedded.hs 39
- let typeArg = read (head args) :: PlugType -- get Plug type
- idArg = toNativeWindowId $ read (last args) :: NativeWindowId -- get GtkSocket id
-
- case typeArg of
- PlugEditor -> editorPlugMain idArg -- entry eidtor plug main
- PlugTerminal -> terminalPlugMain idArg -- entry terminal plug main
+ let pType = read (head args) :: PlugType -- get Plug type
+ id = toNativeWindowId $ read (last args) :: NativeWindowId -- get GtkSocket id
hunk ./demo/embbeded/Embedded.hs 42
+ plugMain id pType
hunk ./demo/embbeded/Embedded.hs 46
--- | Handle key press.
-handleKeyPress :: E.Event -> Notebook -> IO Bool
-handleKeyPress ev notebook = [_$_]
- case eventTransform ev of
- Nothing -> return False
- Just e -> [_$_]
- case eventGetName e of
- "M-m" -> forkPlugProcess notebook PlugEditor "Editor" >> return True
- "M-n" -> forkPlugProcess notebook PlugTerminal "Terminal" >> return True
- _ -> return False
-
--- | Fork plug process.
-forkPlugProcess :: Notebook -> PlugType -> String -> IO ()
-forkPlugProcess notebook plugType tabName = do
- -- Create new GtkSocket.
- socket <- socketNew
- widgetShow socket -- must show before add GtkSocekt to container
- notebookAppendPage notebook socket tabName -- add to GtkSocekt notebook
- id <- socketGetId socket -- get GtkSocket id
-
- -- Fork process to add GtkPlug into GtkSocekt. [_$_]
- forkProcess (do
- path <- liftM2 (</>) getCurrentDirectory getProgName -- get program full path
- executeFile path False [show plugType, show $ fromNativeWindowId id] Nothing)
- return ()
-
hunk ./demo/embbeded/Embedded.hs 63
- window `onKeyPress` (\event -> handleKeyPress event notebook)
+ window `on` keyPressEvent $ tryEvent $ do
+ keyModifier <- eventModifier
+ keyName <- eventKeyName
+ liftIO $ when (keyModifier == [Alt]) $ [_$_]
+ case keyName of
+ "m" -> forkPlugProcess notebook PlugEditor "Editor" -- create editor GtkPlug
+ "n" -> forkPlugProcess notebook PlugTerminal "Terminal" -- create terminal GtkPlug
hunk ./demo/embbeded/Embedded.hs 75
--- | Editor plug main.
-editorPlugMain :: NativeWindowId -> IO ()
-editorPlugMain id = do
- -- Create editor.
- textView <- textViewNew
- textBuffer <- textViewGetBuffer textView
- textBufferSetText textBuffer $ show id
-
- plugWrap id textView
+-- | GtkPlug main.
+plugMain :: NativeWindowId -> PlugType -> IO ()
+plugMain id PlugEditor = plugWrap id =<< createEditor
+plugMain id PlugTerminal = plugWrap id =<< createTerminal
hunk ./demo/embbeded/Embedded.hs 80
--- | Terminal plug main.
-terminalPlugMain :: NativeWindowId -> IO ()
-terminalPlugMain id = do
- -- Create terminal.
- terminal <- terminalNew
- terminalForkCommand terminal Nothing Nothing Nothing Nothing False False False
+-- | Fork plug process.
+forkPlugProcess :: Notebook -> PlugType -> String -> IO ()
+forkPlugProcess notebook plugType tabName = do
+ -- Create new GtkSocket.
+ socket <- socketNew
+ widgetShow socket -- must show before add GtkSocekt to container
+ notebookAppendPage notebook socket tabName -- add to GtkSocekt notebook
+ id <- socketGetId socket -- get GtkSocket id
hunk ./demo/embbeded/Embedded.hs 89
- plugWrap id terminal
+ -- Fork process to add GtkPlug into GtkSocekt. [_$_]
+ path <- liftM2 (</>) getCurrentDirectory getProgName -- get program full path
+ forkProcess (executeFile path False [show plugType, show $ fromNativeWindowId id] Nothing)
+ return ()
hunk ./demo/embbeded/Embedded.hs 113
-
hunk ./demo/embbeded/Embedded.hs 114
+-- Create editor widget.
+createEditor :: IO TextView
+createEditor = textViewNew
+ [_$_]
+-- Create terminal widget.
+createTerminal :: IO Terminal [_$_]
+createTerminal = do
+ terminal <- terminalNew
+ terminalForkCommand terminal Nothing Nothing Nothing Nothing False False False
+ return terminal
hunk ./demo/embbeded/Event.hs 1
-module Event where
-
-import Data.List
-
-import Key
-
-import qualified Graphics.UI.Gtk.Gdk.Events as E
-
--- | The advanced event.
-data Event = Event Key [Modifier] deriving (Eq)
-
--- | Output event describe.
-eventGetName :: Event -> String
-eventGetName (Event key mods) = concatMap ((++ "-") . keyModifier) mods ++ keyDescribe key
- where [_$_]
- -- Key describe
- keyDescribe (KFun i) = 'F' : show i -- Function key (F1, F2, F3... etc.)
- keyDescribe (KASCII c) = [c] -- Character key ('A', 'B', 'C'... etc.)
- keyDescribe k = tail $ show k -- Control key (Ctrl, Alt, Shift... etc.)
- -- Key modifier
- keyModifier m = [show m !! 1]
-
--- | Transform basic event to advanced event. [_$_]
-eventTransform :: E.Event -> Maybe Event
-eventTransform (E.Key {E.eventKeyName = keyName, [_$_]
- E.eventKeyChar = keyChar,
- E.eventModifier = keyModifier})
- = fmap (\k -> Event k [_$_]
- (nub $ sort $ (if isShift [_$_]
- then filter (/= MShift) [_$_]
- else id) -- key
- $ concatMap eventTransformModifier keyModifier)) -- modifier
- key
- where
- (key, isShift) =
- case keyChar of
- Just c -> (Just $ KASCII c, True) -- character key
- Nothing -> (keyLookup keyName, False) -- other key
-eventTransform _ = Nothing
-
--- | Transform event modifier.
-eventTransformModifier E.Control = [MCtrl]
-eventTransformModifier E.Alt = [MMeta]
-eventTransformModifier E.Shift = [MShift]
-eventTransformModifier E.Super = [MSuper]
-eventTransformModifier _ = [] -- Use underscore so we don't depend on the differences between gtk2hs versions
rmfile ./demo/embbeded/Event.hs
hunk ./demo/embbeded/Key.hs 1
-module Key where
-
-import Data.Map (Map)
-
-import Text.Regex.TDFA
-import Data.Maybe
-
-import qualified Data.Map as M
-
--- | The key modifier for transform event.
-data Modifier = MShift | MCtrl | MMeta | MSuper
- deriving (Show,Eq,Ord)
-
--- | The key type.
-data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns
- | KHome | KEnd | KPageUp | KPageDown | KDel | KNP5 | KUp | KMenu
- | KLeft | KDown | KRight | KEnter | KTab [_$_]
- deriving (Eq,Show,Ord)
-
-type Keytable = Map String Key
-
--- | Map GTK long names to Keys
-keyTable :: Keytable
-keyTable = M.fromList
- [("Down", KDown)
- ,("Up", KUp)
- ,("Left", KLeft)
- ,("Right", KRight)
- ,("Home", KHome)
- ,("End", KEnd)
- ,("BackSpace", KBS)
- ,("Delete", KDel)
- ,("Page_Up", KPageUp)
- ,("Page_Down", KPageDown)
- ,("Insert", KIns)
- ,("Escape", KEsc)
- ,("Return", KEnter)
- ,("Tab", KTab)
- ,("ISO_Left_Tab", KTab)]
-
--- | Lookup key name from key table.
-keyLookup :: String -> Maybe Key
-keyLookup keyName = [_$_]
- case key of
- Just k -> Just k -- control key
- Nothing -> if keyName =~ "^F[0-9]+$" :: Bool [_$_]
- then Just $ KFun (read (tail keyName) :: Int) -- function key
- else Nothing -- other key
- where
- key = M.lookup keyName keyTable
rmfile ./demo/embbeded/Key.hs
hunk ./demo/embbeded/Makefile 1
-
hunk ./demo/embbeded/Makefile 2
-SOURCES = Embedded.hs Event.hs Key.hs
+SOURCES = Embedded.hs
|
|
From: Axel S. <si...@co...> - 2009-11-22 22:26:39
|
Sun Nov 22 17:22:24 EST 2009 Axe...@en...
* Remove the use of weak reference from gstreamer.
As a temporary hack I removed the code to clean up a function closure. The
old code relied on GWeakRef which has been removed from GObject due to
the GC being able to finalize GObjects directly which will make
GWeakRefs trigger callbacks into Haskell land form the unsafe GC.
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 243
-weakNotifyQuark, funPtrQuark :: Quark
-weakNotifyQuark = unsafePerformIO $ quarkFromString "Gtk2HS::SyncHandlerWeakNotify"
+-- Note: I've removed this magic since GWeakNotify had to moved out of
+-- GObject since GObject can be finalized directly from the Haskell GC
+-- which can (and will in the case below) callbacks into Haskell that
+-- will make the program abort. We're leaking the function closure instead.
+--weakNotifyQuark,
+funPtrQuark :: Quark
+--weakNotifyQuark = unsafePerformIO $ quarkFromString "Gtk2HS::SyncHandlerWeakNotify"
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 252
+{-
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 263
+-}
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 281
+{-
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 287
+-}
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 313
+{- [_$_]
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 316
+-}
|
|
From: Axel S. <si...@co...> - 2009-11-22 21:55:08
|
Sun Nov 22 16:53:34 EST 2009 Axel Simon <Axe...@en...>
* Give correct name to the new Utils files in glib.
hunk ./Makefile.am 305
- glib/System/Glib/Utils.chs.pp
+ glib/System/Glib/Utils.chs
|
|
From: Axel S. <si...@co...> - 2009-11-22 19:30:32
|
Sun Nov 22 13:52:55 EST 2009 Axel Simon <Axe...@en...>
* Move the weak reference function to disallow weak references from GObjects.
hunk ./Makefile.am 842
+ gtk/Graphics/UI/Gtk/Abstract/Object_stub.o \
hunk ./glib/System/Glib/GObject.chs.pp 50
- -- ** Weak references
- GWeakNotify,
- objectWeakref,
- objectWeakunref,
-
hunk ./glib/System/Glib/GObject.chs.pp 146
-mkFunPtrDestroyNotify hPtr = do
- dRef <- newIORef nullFunPtr
- dPtr <- mkDestroyNotifyPtr $ do
- freeHaskellFunPtr hPtr
- dPtr <- readIORef dRef
- freeHaskellFunPtr dPtr
- writeIORef dRef dPtr
- return dPtr
-
-{#pointer GWeakNotify#}
-
-foreign import ccall "wrapper" mkDestructor :: IO () -> IO GWeakNotify
+mkFunPtrDestroyNotify hPtr = return freeCallbackFunPtr
hunk ./glib/System/Glib/GObject.chs.pp 148
--- | Attach a callback that will be called after the
--- destroy hooks have been called
---
-objectWeakref :: GObjectClass o => o -> IO () -> IO GWeakNotify
-objectWeakref obj uFun = do
- funPtrContainer <- newIORef nullFunPtr
- uFunPtr <- mkDestructor $ do
- uFun
- funPtr <- readIORef funPtrContainer
- freeHaskellFunPtr funPtr
- writeIORef funPtrContainer uFunPtr
- {#call unsafe object_weak_ref#} (toGObject obj) uFunPtr nullPtr
- return uFunPtr
-
--- | Detach a weak destroy callback function
---
-objectWeakunref :: GObjectClass o => o -> GWeakNotify -> IO ()
-objectWeakunref obj fun = [_$_]
- {#call unsafe object_weak_unref#} (toGObject obj) fun nullPtr
+foreign import ccall unsafe "&freeHaskellFunctionPtr" freeCallbackFunPtr :: DestroyNotify
|
|
From: Axel S. <si...@co...> - 2009-11-22 19:30:32
|
Sun Nov 22 14:28:37 EST 2009 Axel Simon <Axe...@en...>
* Add a convenience function to extract the index of an iterator.
hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 39
- [_$_]
+
hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 41
+ listStoreIterToIndex,
|
|
From: Axel S. <si...@co...> - 2009-11-22 19:30:32
|
Sun Nov 22 14:29:20 EST 2009 Axel Simon <Axe...@en...>
* Add another demo that uses callbacks. This was mainly to test if -threaded now works.
addfile ./demo/treeList/ListText.hs
hunk ./demo/treeList/ListText.hs 1
+import Graphics.UI.Gtk
+import Data.Char
+import Data.List
+import Data.Maybe
+
+data RowInfo = RowInfo { rowString :: String, rowCase :: Maybe Bool }
+
+mkCase Nothing str = str
+mkCase (Just False) str = map toLower str
+mkCase (Just True) str = map toUpper str
+
+advCase Nothing = Just False
+advCase (Just False) = Just True
+advCase (Just True) = Nothing
+
+main :: IO ()
+main = do
+ unsafeInitGUIForThreadedRTS
+ win <- windowNew
+ win `on` objectDestroy $ mainQuit
+
+ content <- readFile "ListText.hs"
+
+ model <- listStoreNew (map (\r -> RowInfo r Nothing) (lines content))
+ view <- treeViewNewWithModel model
+
+ -- add a column showing the index
+ col <- treeViewColumnNew
+ treeViewAppendColumn view col
+
+ cell <- cellRendererTextNew
+ cellLayoutPackStart col cell True
+ cellLayoutSetAttributeFunc col cell model $ \(TreeIter _ n _ _) ->
+ set cell [cellText := show n]
+ set col [treeViewColumnTitle := "line",
+ treeViewColumnReorderable := True ]
+
+ -- add a column showing the line in the file
+ col <- treeViewColumnNew
+ treeViewAppendColumn view col
+ set col [treeViewColumnTitle := "line in file",
+ treeViewColumnReorderable := True ]
+
+ cell <- cellRendererTextNew
+ cellLayoutPackStart col cell True
+ cellLayoutSetAttributes col cell model $
+ \row -> [cellText := mkCase (rowCase row) (rowString row)]
+ [_$_]
+ -- add a column showing if it is forced to a specific case
+ col <- treeViewColumnNew
+ treeViewAppendColumn view col
+ set col [treeViewColumnTitle := "case",
+ treeViewColumnReorderable := True ]
+
+ cell <- cellRendererToggleNew
+ cellLayoutPackStart col cell True
+ cellLayoutSetAttributes col cell model $
+ \row -> [cellToggleActive := fromMaybe False (rowCase row),
+ cellToggleInconsistent := rowCase row==Nothing]
+ cell `on` cellToggled $ \tpStr -> do
+ let [i] = stringToTreePath tpStr
+ row@RowInfo { rowCase = c } <- listStoreGetValue model i
+ listStoreSetValue model i row { rowCase = advCase c }
+
+ -- to annoy the user: don't allow any columns to be dropped at the far right
+ treeViewSetColumnDragFunction view $ Just $ \_ rCol _ -> do
+ putStrLn ("querying reorderability")
+ return (rCol /= Nothing)
+
+ view `on` cursorChanged $ do
+ putStrLn "Cursor changed"
+ mapM_ (const windowNew) [0..10]
+
+
+ treeViewSetSearchEqualFunc view $ Just $ \str (TreeIter _ n _ _) -> do
+ row <- listStoreGetValue model (fromIntegral n)
+ return (map toLower str `isPrefixOf` map toLower (filter isAlphaNum (rowString row)))
+
+ swin <- scrolledWindowNew Nothing Nothing
+ set swin [ containerChild := view ]
+ set win [ containerChild := swin ]
+ widgetShowAll win
+ mainGUI
+
hunk ./demo/treeList/Makefile 3
- listdnd filterdemo
+ listdnd filterdemo listtext
hunk ./demo/treeList/Makefile 6
- TreeSort.hs Completion.hs ListDND.hs FilterDemo.hs
+ TreeSort.hs Completion.hs ListDND.hs FilterDemo.hs ListText.hs
hunk ./demo/treeList/Makefile 36
+
+listtext : ListText.hs
+ $(HC_RULE)
|
|
From: Axel S. <si...@co...> - 2009-11-22 19:30:31
|
Sun Nov 22 14:28:28 EST 2009 Axel Simon <Axe...@en...>
* Use the C function to finalize dynamic functions.
This patch changes mkDestoryNotifyPtr to only return the address of the
ghc C function freeHaskellPtr. Thus, any closures passed to Gtk+
functions are now directly freed by a C function rather than calling
back into the Haskell system. The downside is that this C function does not
know which object to finalize. It is, however, called with the data that
is supposed to be passed to the callback function. This used to be
nullPtr since this argument was not used. To make things work,
this argument now always has to be the address of the callback function
so that freeHaskellPtr will get this address as a an argument.
If I forgot to change any uses of mkDestroyNotifyPtr, then using this
function will lead to a SEGFAULT since freeHaskellPtr is called with NULL.
Gtk2Hs programs producing a SEGFAULT when closing are an indication of this.
hunk ./glib/System/Glib/MainLoop.chs.pp 117
- nullPtr
+ (castFunPtrToPtr funPtr)
hunk ./glib/System/Glib/MainLoop.chs.pp 136
- nullPtr dPtr
+ (castFunPtrToPtr funPtr) dPtr
hunk ./glib/System/Glib/MainLoop.chs.pp 189
- nullPtr
+ (castFunPtrToPtr funPtr)
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Bus.chs.pp 368
- nullPtr
+ (castFunPtrToPtr busFuncPtr)
hunk ./gstreamer/Media/Streaming/GStreamer/Core/Index.chs 143
- {# call index_set_filter_full #} (toIndex index) cFilter nullPtr destroyNotify
+ {# call index_set_filter_full #} (toIndex index) cFilter
+ (castFunPtrToPtr cFilter) destroyNotify
hunk ./gtk/Graphics/UI/Gtk.hs.pp 407
-import Graphics.UI.Gtk.Abstract.Object
+import Graphics.UI.Gtk.Abstract.Object (
+ Object,
+ ObjectClass,
+ castToObject,
+ toObject,
+ GWeakNotify,
+ objectWeakref,
+ objectWeakunref,
+ objectDestroy )
hunk ./gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp 63
+-- * Weak references
+ GWeakNotify,
+ objectWeakref,
+ objectWeakunref,
+
hunk ./gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp 83
+import Data.IORef
hunk ./gtk/Graphics/UI/Gtk/Abstract/Object.chs.pp 124
+{#pointer GWeakNotify#}
+
+foreign import ccall "wrapper" mkDestructor :: IO () -> IO GWeakNotify
+
+-- | Attach a callback that will be called after the
+-- destroy hooks have been called
+--
+objectWeakref :: ObjectClass o => o -> IO () -> IO GWeakNotify
+objectWeakref obj uFun = do
+ funPtrContainer <- newIORef nullFunPtr
+ uFunPtr <- mkDestructor $ do
+ uFun
+ funPtr <- readIORef funPtrContainer
+ freeHaskellFunPtr funPtr
+ writeIORef funPtrContainer uFunPtr
+ {#call unsafe g_object_weak_ref#} (toGObject obj) uFunPtr nullPtr
+ return uFunPtr
+
+-- | Detach a weak destroy callback function
+--
+objectWeakunref :: ObjectClass o => o -> GWeakNotify -> IO ()
+objectWeakunref obj fun = [_$_]
+ {#call unsafe g_object_weak_unref#} (toGObject obj) fun nullPtr
+
hunk ./gtk/Graphics/UI/Gtk/ActionMenuToolbar/ActionGroup.chs.pp 369
- nullPtr
+ (castFunPtrToPtr funcPtr)
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs.pp 312
--- 'System.Glib.Signals.signalBlock'. After the default signal
+-- 'signalBlock'. After the default signal
hunk ./gtk/Graphics/UI/Gtk/Entry/EntryCompletion.chs.pp 240
- (castFunPtr hPtr) nullPtr dPtr
+ (castFunPtr hPtr) (castFunPtrToPtr hPtr) dPtr
hunk ./gtk/Graphics/UI/Gtk/General/Clipboard.chs.pp 265
--- when data is not needed anymore, thus we provide an IO action. Anyway,
--- this function is copy and paste of the mkFunPtrDestroyNotify function
--- in GObject.
+-- when data is not needed anymore, thus we provide an IO action.
hunk ./gtk/Graphics/UI/Gtk/MenuComboToolbar/ComboBox.chs.pp 502
- (toComboBox self) funPtr nullPtr desPtr
+ (toComboBox self) funPtr (castFunPtrToPtr funPtr) desPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/CellLayout.chs.pp 238
- (toCellRenderer cell) fPtr nullPtr destroy
+ (toCellRenderer cell) fPtr (castFunPtrToPtr fPtr) destroy
hunk ./gtk/Graphics/UI/Gtk/ModelView/CellRendererToggle.chs.pp 208
--- | The 'cellToggled' signal is emitted when the cell is toggled.
+-- | The 'cellToggled' signal is emitted when the cell is toggled. The string
+-- represents a 'TreePath' into the model and can be converted using
+-- 'stringToTreePath'.
hunk ./gtk/Graphics/UI/Gtk/ModelView/ListStore.hs.pp 127
+-- | Convert a 'TreeIter' to an an index into the 'ListStore'. Note that this
+-- function merely extracts the second element of the 'TreeIter'.
+listStoreIterToIndex :: TreeIter -> Int
+listStoreIterToIndex (TreeIter _ n _ _) = fromIntegral n
+
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeModelFilter.chs.pp 162
- (toTreeModelFilter self) funcPtr nullPtr destroyPtr
+ (toTreeModelFilter self) funcPtr (castFunPtrToPtr funcPtr) destroyPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSelection.chs.pp 156
- nullPtr
+ (castFunPtrToPtr fPtr)
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSortable.chs.pp 167
- fPtr nullPtr dPtr
+ fPtr (castFunPtrToPtr fPtr) dPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeSortable.chs.pp 198
- fPtr nullPtr dPtr
+ fPtr (castFunPtrToPtr fPtr) dPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 561
- nullPtr dPtr
+ (castFunPtrToPtr fPtr) dPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 1074
- nullPtr dPtr
+ (castFunPtrToPtr fPtr) dPtr
hunk ./gtk/Graphics/UI/Gtk/ModelView/TreeView.chs.pp 1326
- (toTreeView self) funcPtr nullPtr destroyPtr
+ (toTreeView self) funcPtr (castFunPtrToPtr funcPtr) destroyPtr
hunk ./gtk/Graphics/UI/Gtk/Selectors/FileFilter.chs.pp 191
- nullPtr
+ (castFunPtrToPtr hPtr)
hunk ./gtk/Graphics/UI/Gtk/Windows/AboutDialog.chs.pp 448
- nullPtr
+ (castFunPtrToPtr funcPtr)
hunk ./gtk/Graphics/UI/Gtk/Windows/AboutDialog.chs.pp 467
- nullPtr
+ (castFunPtrToPtr funcPtr)
|
|
From: Axel S. <si...@co...> - 2009-11-22 12:26:41
|
Sat Nov 21 08:21:29 EST 2009 Axe...@en...
* Add a wrapper around the finalizer of Gtk objects.
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 13
+#include <gdk/gdk.h>
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 15
+static GStaticRecMutex gtk2hs_mutex;
+
+/* Lock the Gtk2Hs lock. */
+void gtk2hs_lock() {
+ g_static_rec_mutex_lock(>k2hs_mutex);
+}
+
+/* Unlock the Gtk2Hs lock. */
+void gtk2hs_unlock() {
+ g_static_rec_mutex_unlock(>k2hs_mutex);
+}
+
+/* Initialize the threads system of Gdk and Gtk. Furthermore, install the
+Gtk2Hs specific lock and unlock functions. */
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 34
+ gdk_threads_set_lock_functions((GCallback) >k2hs_lock,
+ (GCallback) >k2hs_unlock );
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 37
+ gdk_threads_init();
+ g_static_rec_mutex_init(>k2hs_mutex);
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 41
+
+/* Free an object within the Gtk2Hs lock. */
+void gtk2hs_g_object_unref_locked(gpointer object) {
+ g_static_rec_mutex_lock(>k2hs_mutex);
+ g_object_unref(object);
+ g_static_rec_mutex_unlock(>k2hs_mutex);
+}
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.h 1
-int gtk2hs_threads_initialise ();
+#include <glib.h>
+
+#ifndef HSGTHREAD_H
+#define HSGTHREAD_H
+
+/* Lock the Gtk2Hs lock. */
+void gtk2hs_lock(void);
+
+/* Unlock the Gtk2Hs lock. */
+void gtk2hs_unlock(void);
+
+/* Initialize the threads system of Gdk and Gtk. Furthermore, install the
+Gtk2Hs specific lock and unlock functions. */
+int gtk2hs_threads_initialise (void);
+
+/* Free an object within the Gtk2Hs lock. */
+void gtk2hs_g_object_unref_locked(gpointer object);
+
+#endif HSGTHREAD_H
+
|
|
From: Axel S. <si...@co...> - 2009-11-22 12:26:39
|
Sun Nov 22 07:08:04 EST 2009 Axel Simon <Axe...@en...>
* Add finialization from the Gtk+ main loop.
This patch adds a replaces the default destroy function for any GObject that
is created in Gtk+ or any libraries that use Gtk+. These objects are now
finalized using an idle handler that is executed by the Gtk+ main loop.
By being executed by the main loop, the finalizers are run from the same
thread as the main loop and, hence, the objects that hold Xlib or Win32
resources will now free these resources from the thread that normally
calls into Xlib/Win32. This fixes a problem with the -threaded runtime
of ghc in which finalization of objects could happen from other threads
which would cause Xlib errors.
hunk ./Makefile.am 796
- gtk/Graphics/UI/Gtk/General/Selection.chs.pp \
- gtk/Graphics/UI/Gtk/General/Drag.chs.pp \
- gtk/Graphics/UI/Gtk/General/DNDTypes.chs
+ gtk/Graphics/UI/Gtk/General/Selection.chs.pp \
+ gtk/Graphics/UI/Gtk/General/Drag.chs.pp \
+ gtk/Graphics/UI/Gtk/General/DNDTypes.chs \
+ gtk/Graphics/UI/Gtk/General/Threading.hs
+
hunk ./Makefile.am 822
- gtk/Graphics/UI/Gtk/General/DNDTypes.hs
+ gtk/Graphics/UI/Gtk/General/DNDTypes.hs \
+ gtk/Graphics/UI/Gtk/General/Threading.hs
hunk ./Makefile.am 885
- --forward=*System.Glib.GObject)
+ --forward=*System.Glib.GObject --destructor=objectUnrefFromMainloop \
+ --forward=Graphics.UI.Gtk.General.Threading )
hunk ./Makefile.am 1029
- --modname=Graphics.UI.Gtk.Glade.Types \
+ --modname=Graphics.UI.Gtk.Glade.Types \
+ --destructor=objectUnrefFromMainloop \
hunk ./Makefile.am 1165
+ --destructor=objectUnrefFromMainloop \
hunk ./Makefile.am 1451
+ --destructor=objectUnrefFromMainloop \
hunk ./Makefile.am 1593
+ --destructor=objectUnrefFromMainloop \
hunk ./Makefile.am 1726
+ --destructor=objectUnrefFromMainloop \
hunk ./Makefile.am 2115
+ --destructor=objectUnrefFromMainloop \
addfile ./gtk/Graphics/UI/Gtk/General/Threading.hs
hunk ./gtk/Graphics/UI/Gtk/General/Threading.hs 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) General
+--
+-- Author : Axel Simon
+--
+-- Created: 9 May 2009
+--
+-- Copyright (C) 2009 Axel Simon
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- |
+-- Maintainer : gtk...@li...
+-- Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- Support for the threaded RTS of ghc.
+--
+module Graphics.UI.Gtk.General.Threading (
+ objectUnrefFromMainloop
+ ) where
+
+import System.Glib.FFI
+
+foreign import ccall unsafe "hsgthread.h >k2hs_g_object_unref_from_mainloop"
+ objectUnrefFromMainloop :: FinalizerPtr a
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 10
+ *
+ * Besides the interaction with ghci, we provide a variant of g_object_unref
+ * that is used in all objects of Gtk+ and those libraries that build on Gtk+.
+ * This variant enqueues the object to be finalized and adds an idle handler
+ * into the main loop of Gtk+ that will call the actual finalizers on the
+ * enqueued objects. The aim is to ensure that finalizers for objects that
+ * may hold Xlib or Win32 resources are only run from the thread that runs the
+ * main Gtk+ loop. If this is not ensured then bad things happen at least on
+ * Win32 since that API is making use of thread-local storage that is not
+ * present if the finalizers, that are run by the GC in a different thread,
+ * call back into Win32 without this thread-local storage.
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 23
+#include <glib.h>
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 27
-static GStaticRecMutex gtk2hs_mutex;
+#undef DEBUG
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 29
-/* Lock the Gtk2Hs lock. */
-void gtk2hs_lock() {
- g_static_rec_mutex_lock(>k2hs_mutex);
-}
+static GStaticMutex gtk2hs_finalizer_mutex;
+static GSource* gtk2hs_finalizer_source;
+static guint gtk2hs_finalizer_id;
+static GArray* gtk2hs_finalizers;
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 34
-/* Unlock the Gtk2Hs lock. */
-void gtk2hs_unlock() {
- g_static_rec_mutex_unlock(>k2hs_mutex);
-}
+gboolean gtk2hs_run_finalizers(gpointer data);
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 36
-/* Initialize the threads system of Gdk and Gtk. Furthermore, install the
-Gtk2Hs specific lock and unlock functions. */
+/* Initialize the threads system of Gdk and Gtk. */
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 42
- gdk_threads_set_lock_functions((GCallback) >k2hs_lock,
- (GCallback) >k2hs_unlock );
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 44
- g_static_rec_mutex_init(>k2hs_mutex);
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 48
-void gtk2hs_g_object_unref_locked(gpointer object) {
- g_static_rec_mutex_lock(>k2hs_mutex);
- g_object_unref(object);
- g_static_rec_mutex_unlock(>k2hs_mutex);
+void gtk2hs_g_object_unref_from_mainloop(gpointer object) {
+ g_static_mutex_lock(>k2hs_finalizer_mutex);
+
+#ifdef DEBUG
+ printf("adding finalizer!\n");
+#endif
+
+ /* Ensure that the idle handler is still installed and that
+ the array of objects that are to be finalized exists. */
+ if (gtk2hs_finalizer_id==0) {
+
+ if (gtk2hs_finalizers == NULL)
+ gtk2hs_finalizers = g_array_new(0, 0, sizeof(gpointer));
+
+ if (gtk2hs_finalizer_source != NULL) {
+ g_source_destroy(gtk2hs_finalizer_source);
+ g_source_unref(gtk2hs_finalizer_source);
+ };
+
+ gtk2hs_finalizer_source = g_idle_source_new();
+ g_source_set_callback(gtk2hs_finalizer_source, >k2hs_run_finalizers, 0, 0);
+ gtk2hs_finalizer_id = g_source_attach(gtk2hs_finalizer_source, NULL);
+
+ };
+
+ /* Add the object to the list. */
+ g_array_append_val(gtk2hs_finalizers, object);
+
+ g_static_mutex_unlock(>k2hs_finalizer_mutex);
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.c 79
+/* Run the finalizers that have been accumulated. */
+gboolean gtk2hs_run_finalizers(gpointer data) {
+ gint index;
+ g_assert(gtk2hs_finalizers!=NULL);
+
+ g_static_mutex_lock(>k2hs_finalizer_mutex);
+
+#ifdef DEBUG
+ printf("running %i finalizers!\n", gtk2hs_finalizers->len);
+#endif
+
+ for (index = 0; index < gtk2hs_finalizers->len; index++)
+ g_object_unref(g_array_index (gtk2hs_finalizers, GObject*, index));
+
+ g_array_set_size(gtk2hs_finalizers, 0);
+
+ gtk2hs_finalizer_id = 0;
+
+ g_static_mutex_unlock(>k2hs_finalizer_mutex);
+
+ return FALSE;
+}
+
+
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.h 6
-/* Lock the Gtk2Hs lock. */
-void gtk2hs_lock(void);
-
-/* Unlock the Gtk2Hs lock. */
-void gtk2hs_unlock(void);
-
-/* Initialize the threads system of Gdk and Gtk. Furthermore, install the
-Gtk2Hs specific lock and unlock functions. */
+/* Initialize the threads system of Gdk and Gtk. */
hunk ./gtk/Graphics/UI/Gtk/General/hsgthread.h 9
-/* Free an object within the Gtk2Hs lock. */
-void gtk2hs_g_object_unref_locked(gpointer object);
+/* Free an object within the Gtk+ main loop. */
+void gtk2hs_g_object_unref_from_mainloop(gpointer object);
|
|
From: Andy S. <And...@co...> - 2009-11-21 17:13:52
|
Sat Nov 21 12:12:21 EST 2009 Andy Stewart <laz...@gm...>
* Add demon for cross-process embedded.
Ignore-this: c8d6723ea37ea41bf293ab835a64ab4c
adddir ./demo/embbeded
addfile ./demo/embbeded/Embedded.hs
hunk ./demo/embbeded/Embedded.hs 1
+-- Use GtkSocket and GtkPlug for cross-process embedded.
+-- Just startup program, press 'Alt-m' to new editor, press `Alt-n` to new terminal.
+-- And those plug widget (editor, terminal) running in child-process, [_$_]
+-- so program won't crash when child-process throw un-catch exception.
+
+module Main where
+
+import System.Posix.Process
+import System.Environment
+import System.Directory
+import System.FilePath ((</>))
+import Control.Monad
+
+import Event
+import Key
+
+import Graphics.UI.Gtk
+import Graphics.UI.Gtk.General.Structs
+import Graphics.UI.Gtk.Vte.Vte
+
+import qualified Graphics.UI.Gtk.Gdk.Events as E
+
+data PlugType = PlugEditor
+ | PlugTerminal
+ deriving (Eq, Ord, Show, Read)
+
+-- | Main.
+main :: IO ()
+main = do
+ -- Init main.
+ initGUI
+
+ -- Get program arguments.
+ args <- getArgs
+
+ case length args of
+ -- Entry socket main when no arguments.
+ 0 -> socketMain [_$_]
+
+ -- Entry plug main when have two arguments.
+ 2 -> do
+ let typeArg = read (head args) :: PlugType -- get Plug type
+ idArg = toNativeWindowId $ read (last args) :: NativeWindowId -- get GtkSocket id
+
+ case typeArg of
+ PlugEditor -> editorPlugMain idArg -- entry eidtor plug main
+ PlugTerminal -> terminalPlugMain idArg -- entry terminal plug main
+
+ -- Otherwise just output error and exit.
+ _ -> putStrLn "Wrong program arguments."
+ [_$_]
+-- | Handle key press.
+handleKeyPress :: E.Event -> Notebook -> IO Bool
+handleKeyPress ev notebook = [_$_]
+ case eventTransform ev of
+ Nothing -> return False
+ Just e -> [_$_]
+ case eventGetName e of
+ "M-m" -> forkPlugProcess notebook PlugEditor "Editor" >> return True
+ "M-n" -> forkPlugProcess notebook PlugTerminal "Terminal" >> return True
+ _ -> return False
+
+-- | Fork plug process.
+forkPlugProcess :: Notebook -> PlugType -> String -> IO ()
+forkPlugProcess notebook plugType tabName = do
+ -- Create new GtkSocket.
+ socket <- socketNew
+ widgetShow socket -- must show before add GtkSocekt to container
+ notebookAppendPage notebook socket tabName -- add to GtkSocekt notebook
+ id <- socketGetId socket -- get GtkSocket id
+
+ -- Fork process to add GtkPlug into GtkSocekt. [_$_]
+ forkProcess (do
+ path <- liftM2 (</>) getCurrentDirectory getProgName -- get program full path
+ executeFile path False [show plugType, show $ fromNativeWindowId id] Nothing)
+ return ()
+
+-- | GtkSocekt main.
+socketMain :: IO () [_$_]
+socketMain = do
+ -- Output message.
+ pid <- getProcessID
+ putStrLn $ "Running in socket process : " ++ show pid
+
+ -- Create top-level window.
+ window <- windowNew
+ windowFullscreen window
+ window `onDestroy` mainQuit
+
+ -- Create notebook to contain GtkSocekt.
+ notebook <- notebookNew
+ window `containerAdd` notebook
+
+ -- Handle key press.
+ window `onKeyPress` (\event -> handleKeyPress event notebook)
+
+ widgetShowAll window
+
+ mainGUI
+
+-- | Editor plug main.
+editorPlugMain :: NativeWindowId -> IO ()
+editorPlugMain id = do
+ -- Create editor.
+ textView <- textViewNew
+ textBuffer <- textViewGetBuffer textView
+ textBufferSetText textBuffer $ show id
+
+ plugWrap id textView
+
+-- | Terminal plug main.
+terminalPlugMain :: NativeWindowId -> IO ()
+terminalPlugMain id = do
+ -- Create terminal.
+ terminal <- terminalNew
+ terminalForkCommand terminal Nothing Nothing Nothing Nothing False False False
+
+ plugWrap id terminal
+
+-- | Plug wrap function.
+plugWrap :: WidgetClass widget => NativeWindowId -> widget -> IO ()
+plugWrap id widget = do
+ -- Output message.
+ pid <- getProcessID
+ putStrLn $ "Running in plug process : " ++ show pid
+
+ -- Create GtkPlug with GtkSocekt id.
+ plug <- plugNew $ Just id
+ plug `onDestroy` mainQuit
+ [_$_]
+ -- Add widget to GtkPlug.
+ scrolledWindow <- scrolledWindowNew Nothing Nothing
+ scrolledWindow `containerAdd` widget
+ plug `containerAdd` scrolledWindow
+
+ widgetShowAll plug [_$_]
+
+ mainGUI
+
addfile ./demo/embbeded/Event.hs
hunk ./demo/embbeded/Event.hs 1
+module Event where
+
+import Data.List
+
+import Key
+
+import qualified Graphics.UI.Gtk.Gdk.Events as E
+
+-- | The advanced event.
+data Event = Event Key [Modifier] deriving (Eq)
+
+-- | Output event describe.
+eventGetName :: Event -> String
+eventGetName (Event key mods) = concatMap ((++ "-") . keyModifier) mods ++ keyDescribe key
+ where [_$_]
+ -- Key describe
+ keyDescribe (KFun i) = 'F' : show i -- Function key (F1, F2, F3... etc.)
+ keyDescribe (KASCII c) = [c] -- Character key ('A', 'B', 'C'... etc.)
+ keyDescribe k = tail $ show k -- Control key (Ctrl, Alt, Shift... etc.)
+ -- Key modifier
+ keyModifier m = [show m !! 1]
+
+-- | Transform basic event to advanced event. [_$_]
+eventTransform :: E.Event -> Maybe Event
+eventTransform (E.Key {E.eventKeyName = keyName, [_$_]
+ E.eventKeyChar = keyChar,
+ E.eventModifier = keyModifier})
+ = fmap (\k -> Event k [_$_]
+ (nub $ sort $ (if isShift [_$_]
+ then filter (/= MShift) [_$_]
+ else id) -- key
+ $ concatMap eventTransformModifier keyModifier)) -- modifier
+ key
+ where
+ (key, isShift) =
+ case keyChar of
+ Just c -> (Just $ KASCII c, True) -- character key
+ Nothing -> (keyLookup keyName, False) -- other key
+eventTransform _ = Nothing
+
+-- | Transform event modifier.
+eventTransformModifier E.Control = [MCtrl]
+eventTransformModifier E.Alt = [MMeta]
+eventTransformModifier E.Shift = [MShift]
+eventTransformModifier E.Super = [MSuper]
+eventTransformModifier _ = [] -- Use underscore so we don't depend on the differences between gtk2hs versions
addfile ./demo/embbeded/Key.hs
hunk ./demo/embbeded/Key.hs 1
+module Key where
+
+import Data.Map (Map)
+
+import Text.Regex.TDFA
+import Data.Maybe
+
+import qualified Data.Map as M
+
+-- | The key modifier for transform event.
+data Modifier = MShift | MCtrl | MMeta | MSuper
+ deriving (Show,Eq,Ord)
+
+-- | The key type.
+data Key = KEsc | KFun Int | KPrtScr | KPause | KASCII Char | KBS | KIns
+ | KHome | KEnd | KPageUp | KPageDown | KDel | KNP5 | KUp | KMenu
+ | KLeft | KDown | KRight | KEnter | KTab [_$_]
+ deriving (Eq,Show,Ord)
+
+type Keytable = Map String Key
+
+-- | Map GTK long names to Keys
+keyTable :: Keytable
+keyTable = M.fromList
+ [("Down", KDown)
+ ,("Up", KUp)
+ ,("Left", KLeft)
+ ,("Right", KRight)
+ ,("Home", KHome)
+ ,("End", KEnd)
+ ,("BackSpace", KBS)
+ ,("Delete", KDel)
+ ,("Page_Up", KPageUp)
+ ,("Page_Down", KPageDown)
+ ,("Insert", KIns)
+ ,("Escape", KEsc)
+ ,("Return", KEnter)
+ ,("Tab", KTab)
+ ,("ISO_Left_Tab", KTab)]
+
+-- | Lookup key name from key table.
+keyLookup :: String -> Maybe Key
+keyLookup keyName = [_$_]
+ case key of
+ Just k -> Just k -- control key
+ Nothing -> if keyName =~ "^F[0-9]+$" :: Bool [_$_]
+ then Just $ KFun (read (tail keyName) :: Int) -- function key
+ else Nothing -- other key
+ where
+ key = M.lookup keyName keyTable
addfile ./demo/embbeded/Makefile
hunk ./demo/embbeded/Makefile 1
+
+PROG = Embedded
+SOURCES = Embedded.hs Event.hs Key.hs
+
+$(PROG) : $(SOURCES)
+ $(HC) --make $< -o $@ $(HCFLAGS) -XForeignFunctionInterface
+
+clean:
+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG)
+
+HC=ghc
|
|
From: Axel S. <si...@co...> - 2009-11-21 14:23:55
|
Sat Nov 21 09:22:49 EST 2009 Axel Simon <Axe...@en...>
* Fix the bug Duncan reported.
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs.pp 339
- pos <- peek posPtr
- pos' <- handler str pos
- poke posPtr pos'
+ pos <- peek (posPtr :: Ptr {#type gint#})
+ pos' <- handler str (fromIntegral pos)
+ poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos')
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs.pp 348
- pos <- peek posPtr
- pos' <- handler str pos
- poke posPtr pos'
+ pos <- peek (posPtr :: Ptr {#type gint#})
+ pos' <- handler str (fromIntegral pos)
+ poke (posPtr :: Ptr {#type gint#}) (fromIntegral pos')
|
|
From: Axel S. <si...@co...> - 2009-11-21 14:23:54
|
Sat Nov 21 09:22:05 EST 2009 Axel Simon <Axe...@en...>
* Comment fixes.
hunk ./gtk/Graphics/UI/Gtk/Abstract/Widget.chs.pp 2458
--- destroy time.
+-- destroy time. However, you might want to connect to the 'objectDestroy'
+-- signal of 'Object'.
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs.pp 37
--- As an example of the latter usage, by connecting the following handler to
--- \"insert_text\", an application can convert all entry into a widget into
--- uppercase.
hunk ./gtk/Graphics/UI/Gtk/Entry/Editable.chs.pp 100
--- the string \"Haskell\". (FIXME: verify)
+-- the string \"Haskell\".
|
|
From: Axel S. <si...@co...> - 2009-11-21 14:23:53
|
Fri Nov 20 13:39:43 EST 2009 John Millikin <jmi...@gm...>
* Add a demo for GtkBuilder.
Ignore-this: ff9747ed9a9245fdf867058750d9f6a7
hunk ./demo/demos.txt 51
+gtkbuilder: same as ./glade, but with GtkBuilder
+
adddir ./demo/gtkbuilder
addfile ./demo/gtkbuilder/GtkBuilderTest.hs
hunk ./demo/gtkbuilder/GtkBuilderTest.hs 1
+module Main where
+
+import Graphics.UI.Gtk
+
+main = do
+ initGUI
+[_^I_][_$_]
+ -- Create the builder, and load the UI file
+ builder <- builderNew
+ builderAddFromFile builder "simple.ui"
+[_^I_][_$_]
+ -- Retrieve some objects from the UI
+ window <- builderGetObject builder castToWindow "window1"
+ button <- builderGetObject builder castToButton "button1"
+[_^I_][_$_]
+ -- Basic user interation
+ button `onClicked` putStrLn "button pressed!"
+ window `onDestroy` mainQuit
+[_^I_][_$_]
+ -- Display the window
+ widgetShowAll window
+ mainGUI
addfile ./demo/gtkbuilder/Makefile
hunk ./demo/gtkbuilder/Makefile 1
+
+PROG = gtkbuildertest
+SOURCES = GtkBuilderTest.hs
+
+$(PROG) : $(SOURCES)
+ $(HC) --make $< -o $@ $(HCFLAGS)
+
+clean:
+ rm -f $(SOURCES:.hs=.hi) $(SOURCES:.hs=.o) $(PROG)
+
+HC=ghc
addfile ./demo/gtkbuilder/simple.ui
hunk ./demo/gtkbuilder/simple.ui 1
+<?xml version="1.0"?>
+<!--*- mode: xml -*-->
+<interface>
+ <object class="GtkWindow" id="window1">
+ <property name="visible">True</property>
+ <property name="title" translatable="yes">window1</property>
+ <property name="type">GTK_WINDOW_TOPLEVEL</property>
+ <property name="window_position">GTK_WIN_POS_NONE</property>
+ <property name="modal">False</property>
+ <property name="resizable">True</property>
+ <property name="destroy_with_parent">False</property>
+ <child>
+ <object class="GtkVBox" id="vbox1">
+ <property name="border_width">6</property>
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">0</property>
+ <child>
+ <object class="GtkLabel" id="label1">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">A simple dialog created in Glade</property>
+ <property name="use_underline">False</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </object>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkButton" id="button1">
+ <property name="visible">True</property>
+ <property name="can_focus">True</property>
+ <property name="relief">GTK_RELIEF_NORMAL</property>
+ <child>
+ <object class="GtkAlignment" id="alignment1">
+ <property name="visible">True</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xscale">0</property>
+ <property name="yscale">0</property>
+ <child>
+ <object class="GtkHBox" id="hbox1">
+ <property name="visible">True</property>
+ <property name="homogeneous">False</property>
+ <property name="spacing">2</property>
+ <child>
+ <object class="GtkImage" id="image1">
+ <property name="visible">True</property>
+ <property name="stock">gtk-apply</property>
+ <property name="icon_size">4</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </object>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ <child>
+ <object class="GtkLabel" id="label2">
+ <property name="visible">True</property>
+ <property name="label" translatable="yes">Press me!</property>
+ <property name="use_underline">True</property>
+ <property name="use_markup">False</property>
+ <property name="justify">GTK_JUSTIFY_LEFT</property>
+ <property name="wrap">False</property>
+ <property name="selectable">False</property>
+ <property name="xalign">0.5</property>
+ <property name="yalign">0.5</property>
+ <property name="xpad">0</property>
+ <property name="ypad">0</property>
+ </object>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">False</property>
+ <property name="fill">False</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+ </child>
+ </object>
+ <packing>
+ <property name="padding">0</property>
+ <property name="expand">True</property>
+ <property name="fill">True</property>
+ </packing>
+ </child>
+ </object>
+ </child>
+ </object>
+</interface>
|
|
From: Axel S. <si...@co...> - 2009-11-21 14:23:53
|
Fri Nov 20 13:38:12 EST 2009 John Millikin <jmi...@gm...>
* Add support for GtkBuilder.
Ignore-this: baf53e703b8b16a6e9ab888c2795e22e
hunk ./Makefile.am 792
+ gtk/Graphics/UI/Gtk/Builder.chs.pp \
hunk ./gtk/Graphics/UI/Gtk.hs.pp 221
+ module Graphics.UI.Gtk.Builder,
hunk ./gtk/Graphics/UI/Gtk.hs.pp 438
+import Graphics.UI.Gtk.Builder
addfile ./gtk/Graphics/UI/Gtk/Builder.chs.pp
hunk ./gtk/Graphics/UI/Gtk/Builder.chs.pp 1
+-- -*-haskell-*-
+-- GIMP Toolkit (GTK) XML Interface Parser
+--
+-- Author: John Millikin
+--
+-- Created: 19 November 2009
+--
+-- Copyright (C) 2009 John Millikin
+--
+-- This library is free software; you can redistribute it and/or
+-- modify it under the terms of the GNU Lesser General Public
+-- License as published by the Free Software Foundation; either
+-- version 2.1 of the License, or (at your option) any later version.
+--
+-- This library is distributed in the hope that it will be useful,
+-- but WITHOUT ANY WARRANTY; without even the implied warranty of
+-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+-- Lesser General Public License for more details.
+--
+-- Notes:
+--
+-- Like the @libglade@ bindings, this module does not support signal
+-- auto-connection.
+--
+-- |
+-- Maintainer : gtk...@li...
+-- Stability : provisional
+-- Portability : portable (depends on GHC)
+--
+-- Build an interface from an XML UI definition
+--
+-- All functions in this module are only available in Gtk 2.12 or higher.
+--
+module Graphics.UI.Gtk.Builder
+#if !GTK_CHECK_VERSION(2,12,0)
+ () where
+#else
+ (
+-- * Detail
+--
+-- A 'Builder' is an auxiliary object that reads textual descriptions of a
+-- user interface and instantiates the described objects. To pass a
+-- description to a 'Builder', perform 'builderAddFromFile' or
+-- 'builderAddFromString'. These computations can be performed multiple
+-- times; the builder merges the content of all descriptions.
+--
+-- A 'Builder' holds a reference to all objects that it has constructed and
+-- drops these references when it is finalized. This finalization can cause
+-- the destruction of non-widget objects or widgets which are not contained
+-- in a toplevel window. For toplevel windows constructed by a builder, it [_$_]
+-- is the responsibility of the user to perform 'widgetDestroy' to get rid
+-- of them and all the widgets they contain.
+--
+-- The computations 'builderGetObject' and 'builderGetObjects' can be used
+-- to access the widgets in the interface by the names assigned to them
+-- inside the UI description. Toplevel windows returned by these functions
+-- will stay around until the user explicitly destroys them with
+-- 'widgetDestroy'. Other widgets will either be part of a larger hierarchy
+-- constructed by the builder (in which case you should not have to worry
+-- about their lifecycle), or without a parent, in which case they have to
+-- be added to some container to make use of them. Non-widget objects need
+-- to be reffed with 'objectRef' to keep them beyond the lifespan of the
+-- builder.
+--
+-- * Class Hierarchy
+-- |
+-- @
+-- | 'GObject'
+-- | +----'GtkBuilder'
+-- @
+
+-- * Types
+ Builder
+ , BuilderClass
+ , castToBuilder
+ , toBuilder
+ , BuilderError (..)
+
+-- * Constructing and adding objects
+ , builderNew
+ , builderAddFromFile
+ , builderAddFromString
+ , builderAddObjectsFromFile
+ , builderAddObjectsFromString
+
+-- * Retrieving objects
+ , builderGetObject
+ , builderGetObjects
+ , builderGetObjectRaw
+ , builderSetTranslationDomain
+ , builderGetTranslationDomain
+ ) where
+
+import Control.Exception (evaluate, throwIO, ErrorCall (..))
+import System.Glib.FFI
+import System.Glib.GError
+import System.Glib.GList
+import System.Glib.UTFString
+import Graphics.UI.Gtk.Abstract.Object (makeNewObject)
+{#import Graphics.UI.Gtk.Types#}
+
+{# context lib="gtk" prefix="gtk" #}
+
+{# enum GtkBuilderError as BuilderError {underscoreToCase} deriving (Show, Eq) #}
+
+---------------------------------------
+-- Constructing and adding objects
+
+-- | Creates a new 'Builder' object.
+builderNew :: IO Builder
+builderNew =
+ makeNewObject mkBuilder $
+ {# call unsafe builder_new #}
+
+-- | Parses a file containing a GtkBuilder UI definition and merges it with
+-- the current contents of the 'Builder'.
+--
+-- * If an error occurs, the computation will throw an exception that can
+-- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the
+-- error codes in 'BuilderError'.
+--
+builderAddFromFile :: Builder -> FilePath -> IO ()
+builderAddFromFile builder path =
+ propagateGError $ \errPtrPtr ->
+ withUTFString path $ \pathPtr ->
+ {# call unsafe builder_add_from_file #}
+ builder pathPtr errPtrPtr
+ >> return ()
+
+-- | Parses a string containing a GtkBuilder UI definition and merges it
+-- with the current contents of the 'Builder'.
+--
+-- * If an error occurs, the computation will throw an exception that can
+-- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the
+-- error codes in 'BuilderError'.
+--
+builderAddFromString :: Builder -> String -> IO ()
+builderAddFromString builder str =
+ propagateGError $ \errPtrPtr ->
+ withUTFStringLen str $ \(strPtr, strLen) ->
+ {# call unsafe builder_add_from_string #}
+ builder strPtr (fromIntegral strLen) errPtrPtr
+ >> return ()
+
+-- | Parses a file containing a GtkBuilder UI definition building only
+-- the requested objects and merges them with the current contents of
+-- the 'Builder'.
+--
+-- * If an error occurs, the computation will throw an exception that can
+-- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the
+-- error codes in 'BuilderError'.
+--
+builderAddObjectsFromFile ::
+ Builder
+ -> FilePath
+ -> [String] -- ^ Object IDs
+ -> IO ()
+builderAddObjectsFromFile builder path ids =
+ propagateGError $ \errPtrPtr ->
+ withUTFString path $ \pathPtr ->
+ withUTFStringArray0 ids $ \idsPtr ->
+ {# call unsafe builder_add_objects_from_file #}
+ builder pathPtr idsPtr errPtrPtr
+ >> return ()
+
+-- | Parses a string containing a GtkBuilder UI definition building only
+-- the requested objects and merges them with the current contents of
+-- the 'Builder'.
+--
+-- * If an error occurs, the computation will throw an exception that can
+-- be caught using e.g. 'System.Glib.GError.catchGErrorJust' and one of the
+-- error codes in 'BuilderError'.
+--
+builderAddObjectsFromString ::
+ Builder
+ -> String
+ -> [String] -- ^ Object IDs
+ -> IO ()
+builderAddObjectsFromString builder str ids =
+ propagateGError $ \errPtrPtr ->
+ withUTFStringLen str $ \(strPtr, strLen) ->
+ withUTFStringArray0 ids $ \idsPtr ->
+ {# call unsafe builder_add_objects_from_string #}
+ builder strPtr (fromIntegral strLen) idsPtr errPtrPtr
+ >> return ()
+
+---------------------------------------
+-- Retrieving objects
+
+-- | Gets the object with the given name. Note that this computation does
+-- not increment the reference count of the returned object.
+builderGetObjectRaw :: Builder
+ -> String -- The ID of the object in the UI file, eg \"button1\".
+ -> IO (Maybe GObject)
+builderGetObjectRaw builder name =
+ withUTFString name $ \namePtr ->
+ maybeNull (makeNewGObject mkGObject) $
+ {# call unsafe builder_get_object #}
+ builder namePtr
+
+-- | Gets the object with the given name, with a conversion function. Note
+-- that this computation does not increment the reference count of the
+-- returned object.
+--
+-- If the object with the given ID is not of the requested type, an
+-- exception will be thrown.
+--
+builderGetObject :: GObjectClass cls =>
+ Builder
+ -> (GObject -> cls) -- ^ A dynamic cast function which returns an object
+ -- of the expected type, eg 'castToButton'
+ -> String -- The ID of the object in the UI file, eg \"button1\".
+ -> IO cls
+builderGetObject builder cast name = do
+ raw <- builderGetObjectRaw builder name
+ case raw of
+ Just obj -> evaluate . cast $ obj
+ Nothing -> throwIO . ErrorCall $
+ "Gtk.Builder.builderGetObject: no object named " ++ show name ++ " in the builder."
+
+-- | Gets all objects that have been constructed by builder. Note that this
+-- computation does not increment the reference counts of the returned
+-- objects.
+builderGetObjects :: Builder -> IO [GObject]
+builderGetObjects builder =
+ {# call unsafe builder_get_objects #}
+ builder
+ >>= readGSList
+ >>= mapM (makeNewGObject mkGObject . return)
+
+-- | Sets the translation domain of the 'Builder'.
+builderSetTranslationDomain :: Builder -> Maybe String -> IO ()
+builderSetTranslationDomain builder domain =
+ maybeWith withUTFString domain $ \domainPtr ->
+ {# call unsafe builder_set_translation_domain #}
+ builder domainPtr
+
+-- | Gets the translation domain of the 'Builder'.
+builderGetTranslationDomain :: Builder -> IO (Maybe String)
+builderGetTranslationDomain builder =
+ {# call unsafe builder_get_translation_domain #}
+ builder
+ >>= maybePeek peekUTFString
+
+#endif
hunk ./tools/hierarchyGen/hierarchy.list 180
+ GtkBuilder if gtk-2.12
|
|
From: Andy S. <And...@co...> - 2009-11-17 10:13:18
|
Tue Nov 17 05:08:46 EST 2009 Andy Stewart <laz...@gm...>
* Add misssing property function and remove unnecessary export functions/comment from Embedding modules.
Ignore-this: 9cb9f9de76b6a84f800c6dc52e6ce337
hunk ./glib/System/Glib/Properties.chs 88
+ writeAttrFromMaybeObjectProperty,
+ readAttrFromMaybeObjectProperty,
hunk ./glib/System/Glib/Properties.chs 329
-newAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') => String -> GType -> ReadWriteAttr gobj (Maybe gobj') (Maybe gobj'')
-newAttrFromMaybeObjectProperty propName gtype =
- newNamedAttr propName (objectGetPropertyMaybeGObject gtype propName) (objectSetPropertyMaybeGObject gtype propName)
- [_$_]
hunk ./glib/System/Glib/Properties.chs 336
+
+newAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj', GObjectClass gobj'') => String -> GType -> ReadWriteAttr gobj (Maybe gobj') (Maybe gobj'')
+newAttrFromMaybeObjectProperty propName gtype =
+ newNamedAttr propName (objectGetPropertyMaybeGObject gtype propName) (objectSetPropertyMaybeGObject gtype propName)
+ [_$_]
+writeAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> WriteAttr gobj (Maybe gobj')
+writeAttrFromMaybeObjectProperty propName gtype =
+ writeNamedAttr propName (objectSetPropertyMaybeGObject gtype propName)
+
+readAttrFromMaybeObjectProperty :: (GObjectClass gobj, GObjectClass gobj') => String -> GType -> ReadAttr gobj (Maybe gobj')
+readAttrFromMaybeObjectProperty propName gtype =
+ readNamedAttr propName (objectGetPropertyMaybeGObject gtype propName)
hunk ./gtk/Graphics/UI/Gtk/Embedding/Embedding.hsc 25
--- TODO
---
--- * NativeWindowId is a CUInt for c2hs and a Word32 for hsc2hs. I used
--- fromIntegral to make it work, but it doesn't feel right.
---
hunk ./gtk/Graphics/UI/Gtk/Embedding/Plug.chs.pp 77
-
--- * Deprecated
-#ifndef DISABLE_DEPRECATED
- onEmbedded,
- afterEmbedded,
-#endif
|
|
From: Axel S. <si...@co...> - 2009-11-17 08:51:44
|
Tue Nov 17 03:50:16 EST 2009 Axel Simon <Axe...@en...>
* Remove deprecated signals, turn Window in to Maybe Window.
hunk ./gtk/Graphics/UI/Gtk/Embedding/Plug.chs.pp 173
- -> IO DrawWindow -- ^ returns the window of the socket, or {@NULL@, FIXME:
- -- this should probably be converted to a Maybe data type}
+ -> IO (Maybe DrawWindow) -- ^ returns the window of the socket
hunk ./gtk/Graphics/UI/Gtk/Embedding/Plug.chs.pp 175
- makeNewGObject mkDrawWindow $
+ maybeNull (makeNewGObject mkDrawWindow) $
hunk ./gtk/Graphics/UI/Gtk/Embedding/Plug.chs.pp 185
--- Default value: FALSE
+-- Default value: @False@
hunk ./gtk/Graphics/UI/Gtk/Embedding/Plug.chs.pp 196
-plugAttrSocketWindow :: PlugClass self => ReadAttr self DrawWindow
-plugAttrSocketWindow = readAttrFromObjectProperty "socket-window"
+plugAttrSocketWindow :: PlugClass self => ReadAttr self (Maybe DrawWindow)
+plugAttrSocketWindow = readAttrFromMaybeObjectProperty "socket-window"
hunk ./gtk/Graphics/UI/Gtk/Embedding/Plug.chs.pp 209
---------------------
--- Deprecated Signals
-
-#ifndef DISABLE_DEPRECATED
-onEmbedded :: PlugClass self => self
- -> IO ()
- -> IO (ConnectId self)
-onEmbedded = connect_NONE__NONE "embedded" False
-{-# DEPRECATED onEmbedded "instead of 'onEmbedded obj' use 'on obj plugEmbedded'" #-}
-
-afterEmbedded :: PlugClass self => self
- -> IO ()
- -> IO (ConnectId self)
-afterEmbedded = connect_NONE__NONE "embedded" True
-{-# DEPRECATED afterEmbedded "instead of 'afterEmbedded obj' use 'after obj plugEmbedded'" #-}
hunk ./gtk/Graphics/UI/Gtk/Embedding/Plug.chs.pp 211
-#endif
|
2 messages has been excluded from this view by a project administrator.
