Re: guile-gtk-1.2 working with guile-1.7.0

[Mikael Djurfeldt <mdj@kvast.blakulla.net>]

[-- Attachment #1: Type: text/plain, Size: 137 bytes --]

Marius Vollmer <mvo@zagadka.ping.de> writes:

> Could you make a new patch against guile-gtk-1.2 from Savannah once
> it works for you?


[-- Attachment #2: guile-gtk-1.2.diff --]
[-- Type: text/plain, Size: 13104 bytes --]

Index: ChangeLog
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/ChangeLog,v
retrieving revision 1.5
diff -u -r1.5 ChangeLog
--- ChangeLog	7 Nov 2002 22:45:30 -0000	1.5
+++ ChangeLog	12 Nov 2002 03:43:38 -0000
@@ -1,3 +1,47 @@
+2002-11-11  Mikael Djurfeldt  <mdj@linnaeus>
+
+	Fixes for separate build-tree:
+
+	* Makefile.am (ACLOCAL): Replaced $(top_srcdir) --> .
+
+	* configure.in: Added output for gtk/config.scm.
+
+	* build-guile-gtk-1.2 (read-file): Load scheme code from
+	import-path instead of using load-from-path.
+
+	* gdk-pixbuf/Makefile.am, glade/Makefile.am, gtk-gl/Makefile.am
+	(BUILD): Look for config.scm in	top_builddir instead of top_srcdir.
+	(*-glue.c): Added -I $(srcdir) to build rule.
+
+	These changes adds coop-pthreads support:
+
+	* gtk-threads.c: Updated copyright notice with 2002.
+	(g_mutex_trylock_guile_impl): Use scm_mutex_trylock instead of
+	coop_mutex_trylock.
+	(struct spawn_data::thread): Removed.
+	(spawn): Don't initialize data member thread.
+	(g_thread_create_guile_impl): Use the SCM handle as new
+	representation for the thread.
+	(g_thread_join_guile_impl, g_thread_self_guile_impl): Support both
+	coop and coop-pthreads.
+	(struct g_guile_thread_functions_for_glib): Use scm_yield instead
+	of coop_yield; only supply coop_abort with coop threads.
+
+	These changes adapt guile-gtk to guile-1.6 while maintaining
+	backward compatibility:
+
+	* Makefile.am (EXTRA_DIST): Added compat.h
+
+	* gtk-support.c: #include "compat.h"
+
+	* guile-gtk.c (sgtk_scm2senum, sgtk_scm2arg, sgtk_scm2ret,
+	sgtk_color_conversion, sgtk_font_conversion,
+	sgtk_string_conversion): Use SCM_STRING_COERCE_0TERMINATION.
+	(Should be here for backward compatibility, no?)
+
+	* build-guile-gtk-1.2 (emit-glue, emit-main): Emit #include
+	"config.h" and #include "compat.h".
+
 2002-11-07  Marius Vollmer  <mvo@zagadka.ping.de>
 
 	* examples/test-glade.scm: Use the (gtk-1.2 ...) modules, not the
Index: Makefile.am
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/Makefile.am,v
retrieving revision 1.3
diff -u -r1.3 Makefile.am
--- Makefile.am	7 Nov 2002 22:45:30 -0000	1.3
+++ Makefile.am	12 Nov 2002 03:43:38 -0000
@@ -4,7 +4,7 @@
 
 INCLUDES = -I$(srcdir) -I. $(GTK_CFLAGS) $(GUILE_CFLAGS)
 
-ACLOCAL = $(top_srcdir)/guile-gtk-aclocal.sh
+ACLOCAL = ./guile-gtk-aclocal.sh
 
 bin_SCRIPTS     = build-guile-gtk-1.2
 lib_LTLIBRARIES = libguilegtk-1.2.la
@@ -59,6 +59,6 @@
 gdk-glue.c: $(gdkdefs) build-guile-gtk-1.2
 	$(BUILD) -I $(srcdir) glue $(gdkdefs) >tmpd && mv tmpd $@
 
-EXTRA_DIST = gdk-1.2.defs gtk-1.2.defs build-guile-gtk-1.2		\
+EXTRA_DIST = gdk-1.2.defs gtk-1.2.defs build-guile-gtk-1.2 compat.h	\
 	     macros/gdk-pixbuf.m4 macros/libglade.m4 macros/gtkgl.m4	\
 	     guile-gtk-aclocal.sh
Index: build-guile-gtk-1.2
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/build-guile-gtk-1.2,v
retrieving revision 1.2
diff -u -r1.2 build-guile-gtk-1.2
--- build-guile-gtk-1.2	7 Nov 2002 20:16:36 -0000	1.2
+++ build-guile-gtk-1.2	12 Nov 2002 03:43:38 -0000
@@ -205,7 +205,7 @@
 		   (read)))
 	    ((and (list? obj) (eq? (car obj) 'load-scheme))
 	     (pk 'loading-scheme (cadr obj))
-	     (load-from-path (cadr obj))
+	     (primitive-load (search-in-path (cadr obj) import-path))
 	     (loop res (read)))
 	    (else
 	     (loop (append (backend obj importing) res) (read))))))
@@ -1456,6 +1456,8 @@
      defs-file)
   (@ "#include <libguile.h>~%")
   (@ "#include <guile-gtk.h>~%")
+  (@ "#include \"config.h\"~%")
+  (@ "#include \"compat.h\"~%")
   (for-each (lambda (inc)
 	      (@ "~a~%" inc))
 	    (get-opt *global-options* 'includes '()))
Index: configure.in
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/configure.in,v
retrieving revision 1.2
diff -u -r1.2 configure.in
--- configure.in	7 Nov 2002 20:16:36 -0000	1.2
+++ configure.in	12 Nov 2002 03:43:38 -0000
@@ -16,6 +16,22 @@
   AC_MSG_ERROR([This package needs gtk-1.2 but we found gtk-$gtk_config_major_version.$gtk_config_minor_version])
 fi
 
+### BEGIN compatibility checks ###
+
+AC_CHECK_FUNCS(scm_c_define_module scm_c_read_string scm_gc_protect_object scm_list_1)
+
+AC_MSG_CHECKING(for scm_t_bits)
+AC_CACHE_VAL(ac_cv_have_scm_t_bits,
+[AC_TRY_COMPILE([#include <libguile.h>],
+[scm_t_bits a;],
+ac_cv_have_scm_t_bits=yes, ac_cv_have_scm_t_bits=no)])
+AC_MSG_RESULT($ac_cv_have_scm_t_bits)
+if test $ac_cv_have_scm_t_bits = yes; then
+  AC_DEFINE(HAVE_SCM_T_BITS)
+fi
+
+### END compatibility checks ###
+
 #--- Test for GdkPixbuf ... -------------------------------------------
  
 AC_ARG_WITH(gdk-pixbuf,
@@ -125,6 +141,7 @@
 	  gdk-pixbuf/Makefile
 	  glade/Makefile
           gtk/Makefile
+	  gtk/config.scm
           gtk-1.2/Makefile
 	  gtk-gl/Makefile
           examples/Makefile
Index: gtk-support.c
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/gtk-support.c,v
retrieving revision 1.2
diff -u -r1.2 gtk-support.c
--- gtk-support.c	7 Nov 2002 20:16:36 -0000	1.2
+++ gtk-support.c	12 Nov 2002 03:43:38 -0000
@@ -24,6 +24,7 @@
 #else
 #include <gtk-1.2/gdk/gdkprivate.h>
 #endif
+#include "compat.h"
 #include "gtk-threads.h"
 
 /* It is not strictly correct to have Gdk support functions here.  But
Index: gtk-threads.c
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/gtk-threads.c,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 gtk-threads.c
--- gtk-threads.c	7 Oct 2002 14:49:50 -0000	1.1.1.1
+++ gtk-threads.c	12 Nov 2002 03:43:38 -0000
@@ -1,5 +1,5 @@
 /* Threading for guile-gtk
- * Copyright (C) 2000 Free Software Foundation
+ * Copyright (C) 2000, 2002 Free Software Foundation
  *
  * This program is free software; you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -34,6 +34,12 @@
 
 #ifdef USE_THREADS
 
+#ifndef USE_COOP_THREADS
+#ifndef USE_COPT_THREADS
+#error No thread package supported by Guile
+#endif
+#endif
+
 extern int errno;
 
 #ifdef FD_SET
@@ -192,7 +198,7 @@
 {
   int result;
 
-  result = coop_mutex_trylock ((scm_t_mutex *) mutex);
+  result = scm_mutex_trylock ((scm_t_mutex *) mutex);
 
   if (result == EBUSY)
     return FALSE;
@@ -289,14 +295,12 @@
 struct spawn_data {
   GThreadFunc func;
   gpointer arg;
-  gpointer thread;
 };
 
 static SCM
 spawn (void *arg)
 {
   struct spawn_data *data = (struct spawn_data *) arg;
-  * (coop_t **) data->thread = coop_global_curr;
   data->func (data->arg);
   return SCM_UNSPECIFIED;
 }
@@ -311,19 +315,28 @@
 			    gpointer thread)
 {
   struct spawn_data data;
+  SCM t;
   data.func = thread_func;
   data.arg = arg;
   data.thread = thread;
-  scm_spawn_thread (spawn, &data, scm_handle_by_message_noexit, 0);
+  t = scm_spawn_thread (spawn, &data, scm_handle_by_message_noexit, 0);
+  * (SCM *) thread = t;
 }
 
 static void
 g_thread_join_guile_impl (gpointer thread)
 {
-  coop_join (* (coop_t **) thread);
+#ifdef USE_COOP_THREADS
+  coop_join ((coop_t *) SCM_THREAD_DATA ((SCM) thread));
+#endif
+#ifdef USE_COPT_THREADS
+  scm_join_thread ((SCM) thread);
+#endif
 }
 
+#ifdef USE_COOP_THREADS
 extern void coop_abort (void);
+#endif
 
 static void
 g_thread_set_priority_guile_impl (gpointer thread, GThreadPriority priority)
@@ -333,7 +346,12 @@
 static void
 g_thread_self_guile_impl (gpointer thread)
 {
-  * (coop_t **) thread = coop_global_curr;
+#ifdef USE_COOP_THREADS
+  * (SCM *) thread = coop_global_curr->handle;
+#endif
+#ifdef USE_COPT_THREADS
+  * (SCM *) thread = cur_thread;
+#endif
 }
 #endif /* HAVE_THREAD_CREATE */
 
@@ -356,9 +374,13 @@
 #ifdef HAVE_THREAD_CREATE
   ,
   g_thread_create_guile_impl,
-  coop_yield,
+  scm_yield,
   g_thread_join_guile_impl,
+#ifdef USE_COOP_THREADS
   coop_abort,
+#else
+  0,
+#endif /* USE_COOP_THREADS */
   g_thread_set_priority_guile_impl,
   g_thread_self_guile_impl
 #endif /* HAVE_THREAD_CREATE */
Index: guile-gtk.c
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/guile-gtk.c,v
retrieving revision 1.3
diff -u -r1.3 guile-gtk.c
--- guile-gtk.c	7 Nov 2002 20:16:36 -0000	1.3
+++ guile-gtk.c	12 Nov 2002 03:43:38 -0000
@@ -991,7 +991,10 @@
   int i;
 
   if (SCM_STRINGP (obj))
-    return SCM_STRING_CHARS (obj);
+    {
+      SCM_STRING_COERCE_0TERMINATION_X (obj);
+      return SCM_STRING_CHARS (obj);
+    }
 
   for (i = 0; i < info->n_literals; i++)
     if (! strcmp (info->literals[i].name, SCM_SYMBOL_CHARS (obj)))
@@ -1910,6 +1913,7 @@
       GTK_VALUE_DOUBLE(*a) = sgtk_scm2double (obj);
       break;
     case GTK_TYPE_STRING:
+      SCM_STRING_COERCE_0TERMINATION_X (obj);
       GTK_VALUE_STRING(*a) = SCM_STRING_CHARS(obj);
       break;
     case GTK_TYPE_ENUM:
@@ -1976,6 +1980,7 @@
     case GTK_TYPE_STRING:
       SCM_ASSERT (SCM_NIMP(obj) && SCM_STRINGP(obj), obj, SCM_ARG1,
 		  "scm->gtk");
+      SCM_STRING_COERCE_0TERMINATION_X (obj);
       GTK_VALUE_STRING(*a) = g_strdup (SCM_STRING_CHARS(obj));
       break;
     case GTK_TYPE_ENUM:
@@ -2114,6 +2119,7 @@
       GdkColor colstruct;
       GdkColormap *colmap;
 
+      SCM_STRING_COERCE_0TERMINATION_X (color);
       if (!gdk_color_parse (SCM_STRING_CHARS (color), &colstruct))
 	{
 	  scm_misc_error ("string->color", "no such color: ~S",
@@ -2139,6 +2145,7 @@
 
   if (SCM_NIMP (font) && SCM_STRINGP (font))
     {
+      SCM_STRING_COERCE_0TERMINATION_X (font);
       font = sgtk_gdk_font_load (font);
       if (font == SCM_BOOL_F)
 	scm_misc_error ("string->font", "no such font: ~S",
@@ -2150,6 +2157,8 @@
 SCM
 sgtk_string_conversion (SCM str)
 {
+  if (SCM_NIMP (str) && SCM_STRINGP (str))
+    SCM_STRING_COERCE_0TERMINATION_X (str);
   return str;
 }
 
Index: gdk-pixbuf/Makefile.am
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/gdk-pixbuf/Makefile.am,v
retrieving revision 1.1
diff -u -r1.1 Makefile.am
--- gdk-pixbuf/Makefile.am	7 Nov 2002 20:16:36 -0000	1.1
+++ gdk-pixbuf/Makefile.am	12 Nov 2002 03:43:38 -0000
@@ -4,7 +4,7 @@
 defsdir = $(datadir)/guile-gtk
 
 INCLUDES = -I$(top_srcdir) $(GDK_PIXBUF_CFLAGS)
-BUILD = guile -l $(top_srcdir)/gtk-1.2/config.scm -s $(top_srcdir)/build-guile-gtk-1.2
+BUILD = guile -l $(top_builddir)/gtk-1.2/config.scm -s $(top_srcdir)/build-guile-gtk-1.2
 
 if BUILD_GDK_PIXBUF
   defs_DATA = gdk-pixbuf.defs
@@ -20,6 +20,6 @@
 CLEANFILES = gdk-pixbuf-glue.c
 
 gdk-pixbuf-glue.c: gdk-pixbuf.defs $(top_srcdir)/build-guile-gtk-1.2
-	$(BUILD) -I $(top_srcdir) glue gdk-pixbuf.defs >tmpd && mv tmpd $@
+	$(BUILD) -I $(top_srcdir) -I $(srcdir) glue gdk-pixbuf.defs >tmpd && mv tmpd $@
 
 EXTRA_DIST = gdk-pixbuf.defs gdk-pixbuf.scm
Index: glade/Makefile.am
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/glade/Makefile.am,v
retrieving revision 1.1
diff -u -r1.1 Makefile.am
--- glade/Makefile.am	7 Nov 2002 20:16:36 -0000	1.1
+++ glade/Makefile.am	12 Nov 2002 03:43:38 -0000
@@ -4,7 +4,7 @@
 defsdir = $(datadir)/guile-gtk
 
 INCLUDES = -I$(top_srcdir) $(LIBGLADE_CFLAGS)
-BUILD = guile -l $(top_srcdir)/gtk-1.2/config.scm -s $(top_srcdir)/build-guile-gtk-1.2
+BUILD = guile -l $(top_builddir)/gtk-1.2/config.scm -s $(top_srcdir)/build-guile-gtk-1.2
 
 if BUILD_GLADE
   defs_DATA = glade.defs
@@ -20,7 +20,7 @@
 CLEANFILES = glade-glue.c glade-support.x
 
 glade-glue.c: glade.defs $(top_srcdir)/build-guile-gtk-1.2
-	$(BUILD) -I $(top_srcdir) glue glade.defs >tmpd && mv tmpd $@
+	$(BUILD) -I $(top_srcdir) -I $(srcdir) glue glade.defs >tmpd && mv tmpd $@
 
 SUFFIXES = .x
 .c.x:
Index: gtk-gl/Makefile.am
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gtk-1.2/gtk-gl/Makefile.am,v
retrieving revision 1.1
diff -u -r1.1 Makefile.am
--- gtk-gl/Makefile.am	7 Nov 2002 20:16:36 -0000	1.1
+++ gtk-gl/Makefile.am	12 Nov 2002 03:43:38 -0000
@@ -4,7 +4,7 @@
 defsdir = $(datadir)/guile-gtk
 
 INCLUDES = -I$(top_srcdir) $(GTKGL_CFLAGS)
-BUILD = guile -l $(top_srcdir)/gtk-1.2/config.scm -s $(top_srcdir)/build-guile-gtk-1.2
+BUILD = guile -l $(top_builddir)/gtk-1.2/config.scm -s $(top_srcdir)/build-guile-gtk-1.2
 
 if BUILD_GTK_GL
   defs_DATA = gdk-gl.defs gtk-gl-area.defs
@@ -21,9 +21,9 @@
 CLEANFILES = gdk-gl-glue.c gtk-gl-area-glue.c
 
 gdk-gl-glue.c: gdk-gl.defs gdk-gl-types.scm $(top_srcdir)/build-guile-gtk-1.2
-	$(BUILD) -I $(top_srcdir) glue gdk-gl.defs >tmpd && mv tmpd $@
+	$(BUILD) -I $(top_srcdir) -I $(srcdir) glue gdk-gl.defs >tmpd && mv tmpd $@
 
 gtk-gl-area-glue.c: gtk-gl-area.defs gdk-gl-types.scm $(top_srcdir)/build-guile-gtk-1.2
-	$(BUILD) -I $(top_srcdir) glue gtk-gl-area.defs >tmpd && mv tmpd $@
+	$(BUILD) -I $(top_srcdir) -I $(srcdir) glue gtk-gl-area.defs >tmpd && mv tmpd $@
 
 EXTRA_DIST = gdk-gl.defs gdk-gl.scm gtk-gl-area.defs gtk-gl-area.scm gdk-gl-types.scm

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: guile-gtk-1.2/compat.h (new file) --]
[-- Type: text/x-chdr, Size: 4021 bytes --]

/* classes: h_files */

#ifndef COMPATH
#define COMPATH
/*	Copyright (C) 2001, 2002 Free Software Foundation, Inc.
 * 
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2, or (at your option)
 * any later version.
 * 
 * This program 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 General Public License for more details.
 * 
 * You should have received a copy of the GNU General Public License
 * along with this software; see the file COPYING.  If not, write to
 * the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
 * Boston, MA 02111-1307 USA
 *
 * As a special exception, the Free Software Foundation gives permission
 * for additional uses of the text contained in its release of GUILE.
 *
 * The exception is that, if you link the GUILE library with other files
 * to produce an executable, this does not by itself cause the
 * resulting executable to be covered by the GNU General Public License.
 * Your use of that executable is in no way restricted on account of
 * linking the GUILE library code into it.
 *
 * This exception does not however invalidate any other reasons why
 * the executable file might be covered by the GNU General Public License.
 *
 * This exception applies only to the code released by the
 * Free Software Foundation under the name GUILE.  If you copy
 * code from other Free Software Foundation releases into a copy of
 * GUILE, as the General Public License permits, the exception does
 * not apply to the code that you add in this way.  To avoid misleading
 * anyone as to the status of such modified files, you must delete
 * this exception notice from them.
 *
 * If you write modifications of your own for GUILE, it is your choice
 * whether to permit this exception to apply to your modifications.
 * If you do not wish that, delete this exception notice.  */
\f

#ifndef SCM_GC8MARKP
#  define SCM_GC8MARKP(X) SCM_GC_MARK_P(X)
#  define SCM_SETGC8MARK(X) SCM_SET_GC_MARK(X)
#endif

#ifndef SCM_GC_MARK_P
#  define SCM_GC_MARK_P(X) SCM_GCMARKP(X)
#  define SCM_SET_GC_MARK(X) SCM_SETGCMARK(X)
#endif

#ifndef SCM_ARRAY_FLAG_CONTIGUOUS
#  define SCM_ARRAY_FLAG_CONTIGUOUS SCM_ARRAY_CONTIGUOUS
#endif

#ifndef HAVE_SCM_T_BITS
typedef scm_bits_t scm_t_bits;
typedef scm_array scm_t_array;
typedef scm_array_dim scm_t_array_dim;
typedef scm_mutex_t scm_t_mutex;
typedef scm_cond_t scm_t_cond;
typedef scm_key_t scm_t_key;
typedef scm_catch_body_t scm_t_catch_body
#endif

#ifndef SCM_VALIDATE_DOUBLE_COPY
#define SCM_VALIDATE_DOUBLE_COPY SCM_VALIDATE_NUMBER_COPY
#endif

#ifndef HAVE_SCM_C_DEFINE_MODULE
#define scm_c_define_module(NAME,INIT,DATA) \
  scm_make_module (scm_read_0str ("(" NAME ")"))
#endif

#ifndef SCM_RWSTRINGP
#define SCM_RWSTRINGP(x) SCM_STRINGP (x)
#endif

#ifndef SCM_STRING_COERCE_0TERMINATION_X
#ifdef SCM_COERCE_SUBSTR
#define SCM_STRING_COERCE_0TERMINATION_X SCM_COERCE_SUBSTR
#else
#define SCM_STRING_COERCE_0TERMINATION_X(x) (x)
#endif
#endif

#ifndef HAVE_SCM_C_READ_STRING
#define scm_c_read_string scm_read_0str
#endif

#ifndef HAVE_SCM_GC_PROTECT_OBJECT
#define scm_gc_protect_object scm_protect_object
#endif

#ifndef SCM_STRING_CHARS
#define SCM_STRING_CHARS SCM_CHARS
#define SCM_STRING_LENGTH SCM_LENGTH
#endif

#ifndef SCM_VECTOR_LENGTH
#define SCM_VECTOR_LENGTH SCM_LENGTH
#endif

#ifndef SCM_SET_UVECTOR_BASE
#define SCM_SET_UVECTOR_BASE SCM_SETCHARS
#define SCM_SET_UVECTOR_LENGTH SCM_SETLENGTH
#define SCM_UVECTOR_MAX_LENGTH SCM_LENGTH_MAX
#endif

#ifndef HAVE_SCM_LIST_1
#define scm_list_1 SCM_LIST1
#define scm_list_2 SCM_LIST2
#define scm_list_3 SCM_LIST3
#define scm_list_4 SCM_LIST4
#define scm_list_5 SCM_LIST5
#define scm_list_n scm_listify
#endif

#ifndef SCM_SYMBOL_CHARS
#define SCM_SYMBOL_CHARS SCM_CHARS
#endif

#endif /* COMPATH */

[-- Attachment #4: Type: text/plain, Size: 91 bytes --]


(I've only tested it with guile-1.7.0/coop-pthreads configuration.)

Best regards,
Mikael