unofficial mirror of guile-devel@gnu.org 
 help / color / mirror / Atom feed
* guile-gtk-1.2 working with guile-1.7.0
@ 2002-11-07 14:40 Mikael Djurfeldt
  2002-11-07 20:29 ` Marius Vollmer
  0 siblings, 1 reply; 7+ messages in thread
From: Mikael Djurfeldt @ 2002-11-07 14:40 UTC (permalink / raw)
  Cc: djurfeldt, Ariel Rios, guile-devel

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

Hi,

Below I supply a patch against the latest cvs.gnome.org version of
guile-gtk + the file gnome-guile/compat.h.  With these changes
guile-gtk should work against any reasonably recent Guile.


[-- Attachment #2: Diff against gnome-guile source tree --]
[-- Type: text/plain, Size: 27879 bytes --]

? compat.h
? guile-gtk/autom4te.cache
? guile-gtk/depcomp
? guile-gtk/missing
? guile-gtk/stamp-h1
? macros/macros.dep
Index: ChangeLog
===================================================================
RCS file: /cvs/gnome/gnome-guile/ChangeLog,v
retrieving revision 1.54
diff -c -r1.54 ChangeLog
*** ChangeLog	4 Jan 2002 05:48:05 -0000	1.54
--- ChangeLog	7 Nov 2002 14:31:10 -0000
***************
*** 1,3 ****
--- 1,9 ----
+ 2001-10-04  Mikael Djurfeldt  <mdj@linnaeus>
+ 
+ 	* compat.h: New file.
+ 	
+ 	* Makefile.am (EXTRA_DIST): Added compat.h.
+ 
  2002-01-03  Ariel Rios  <ariel@gnu.org>
  
  	* configure.in: Acquire CFLAGS for Bonobo.
Index: Makefile.am
===================================================================
RCS file: /cvs/gnome/gnome-guile/Makefile.am,v
retrieving revision 1.7
diff -c -r1.7 Makefile.am
*** Makefile.am	29 Nov 2000 22:30:23 -0000	1.7
--- Makefile.am	7 Nov 2002 14:31:10 -0000
***************
*** 1,5 ****
  SUBDIRS = guile-gtk guile-gnome 
  
! EXTRA_DIST = gnome-guile.spec.in gnome-guile.spec
  
  
--- 1,5 ----
  SUBDIRS = guile-gtk guile-gnome 
  
! EXTRA_DIST = gnome-guile.spec.in gnome-guile.spec compat.h
  
  
Index: guile-gtk/ChangeLog
===================================================================
RCS file: /cvs/gnome/gnome-guile/guile-gtk/ChangeLog,v
retrieving revision 1.229
diff -c -r1.229 ChangeLog
*** guile-gtk/ChangeLog	20 Oct 2002 00:21:05 -0000	1.229
--- guile-gtk/ChangeLog	7 Nov 2002 14:31:11 -0000
***************
*** 1,3 ****
--- 1,30 ----
+ 2001-10-04  Mikael Djurfeldt  <mdj@linnaeus>
+ 
+ 	These changes adapt guile-gtk to guile-1.6 while maintaining
+ 	backward compatibility.
+ 
+ 	* gtk-support.c: #include "../compat.h"; Replaced scm_listify -->
+ 	scm_list_n.
+ 
+ 	* guile-gtk.c: Replaced scm_sizet --> size_t, SCM_LENGTH -->
+ 	SCM_VECTOR_LENGTH, scm_catch_body_t --> scm_t_catch_body.
+ 	
+ 	* build-guile-gtk: Replaced SCM_LIST0 --> SCM_EOL.
+ 	(emit-glue, emit-main): Emit #include "config.h" and #include
+ 	"../compat.h".
+ 
+ 	* build-guile-gtk, guile-gtk.c: Replaced SCM_CHARS -->
+ 	SCM_STRING_CHARS
+ 
+ 	* guile-gtk.c, guiledlopenhelper.c: #include "../compat.h";
+ 	replaced SCM_COERCE_SUBSTR --> SCM_STRING_COERCE_0TERMINATION_X.
+ 
+ 	* Makefile.am (INCLUDES): Added -I. so that config.h is found
+ 	during creation of .x-files.
+ 
+ 	* guile-gtk.c (gtkobj_free, boxed_free): Use size_t instead of
+ 	scm_sizet.
+ 
  2002-10-20  Marius Vollmer  <mvo@zagadka.ping.de>
  
  	* guile-gtk.c (gtkobj_free): Do not move the proxy itself to the
Index: guile-gtk/acconfig.h
===================================================================
RCS file: /cvs/gnome/gnome-guile/guile-gtk/acconfig.h,v
retrieving revision 1.4
diff -c -r1.4 acconfig.h
*** guile-gtk/acconfig.h	30 Sep 2000 06:27:39 -0000	1.4
--- guile-gtk/acconfig.h	7 Nov 2002 14:31:11 -0000
***************
*** 3,5 ****
--- 3,6 ----
  #undef HAVE_GUILE
  #undef HAVE_THREAD_CREATE
  #undef GTK_2_0
+ #undef HAVE_SCM_T_BITS
Index: guile-gtk/build-guile-gtk
===================================================================
RCS file: /cvs/gnome/gnome-guile/guile-gtk/build-guile-gtk,v
retrieving revision 1.40
diff -c -r1.40 build-guile-gtk
*** guile-gtk/build-guile-gtk	24 Jul 2001 22:48:42 -0000	1.40
--- guile-gtk/build-guile-gtk	7 Nov 2002 14:31:11 -0000
***************
*** 3,9 ****
  exec guile -s $0 $*
  !#
  
! ;;	Copyright (C) 1997, 1998, 1999 Marius Vollmer
  ;; 
  ;; This program is free software; you can redistribute it and/or
  ;; modify it under the terms of the GNU General Public License as
--- 3,9 ----
  exec guile -s $0 $*
  !#
  
! ;;	Copyright (C) 1997, 1998, 1999, 2001 Marius Vollmer
  ;; 
  ;; This program is free software; you can redistribute it and/or
  ;; modify it under the terms of the GNU General Public License as
***************
*** 980,986 ****
        (if (null? multiple-values)
  	  (@ "~%  return ~a;~%}~%~%" (type-c2scm rtype "cr_ret" rcopy))
  	  (begin
! 	    (@ "~%  ret_list = SCM_LIST0;")
  	    (for-each (lambda (ret)
  			(@ "~%  ret_list = scm_cons(~a, ret_list);"
  			   (type-c2scm (lookup-type (car ret))
--- 980,986 ----
        (if (null? multiple-values)
  	  (@ "~%  return ~a;~%}~%~%" (type-c2scm rtype "cr_ret" rcopy))
  	  (begin
! 	    (@ "~%  ret_list = SCM_EOL;")
  	    (for-each (lambda (ret)
  			(@ "~%  ret_list = scm_cons(~a, ret_list);"
  			   (type-c2scm (lookup-type (car ret))
***************
*** 1138,1144 ****
  	      (lambda (x) 
  		(@@ "(SCM_NIMP(~a) && SCM_RWSTRINGP(~a))" x x))
  	      (lambda (x) 
! 		(@@ "((~a) == SCM_BOOL_F? NULL : SCM_CHARS(~a))" x x))
  	      (lambda (x copy) 
  		(@@ "(~a == NULL? SCM_BOOL_F : scm_take0str (~a))" x x))
  	      'fit-for-list #t
--- 1138,1144 ----
  	      (lambda (x) 
  		(@@ "(SCM_NIMP(~a) && SCM_RWSTRINGP(~a))" x x))
  	      (lambda (x) 
! 		(@@ "((~a) == SCM_BOOL_F? NULL : SCM_STRING_CHARS(~a))" x x))
  	      (lambda (x copy) 
  		(@@ "(~a == NULL? SCM_BOOL_F : scm_take0str (~a))" x x))
  	      'fit-for-list #t
***************
*** 1150,1156 ****
  	      (lambda (x) 
  		(@@ "(SCM_NIMP(~a) && SCM_RWSTRINGP(~a))" x x))
  	      (lambda (x) 
! 		(@@ "((~a) == SCM_BOOL_F? NULL : SCM_CHARS(~a))" x x))
  	      (lambda (x copy) 
  		(@@ "(~a == NULL? SCM_BOOL_F : scm_take0str (~a))" x x))
  	      'fit-for-list #t
--- 1150,1156 ----
  	      (lambda (x) 
  		(@@ "(SCM_NIMP(~a) && SCM_RWSTRINGP(~a))" x x))
  	      (lambda (x) 
! 		(@@ "((~a) == SCM_BOOL_F? NULL : SCM_STRING_CHARS(~a))" x x))
  	      (lambda (x copy) 
  		(@@ "(~a == NULL? SCM_BOOL_F : scm_take0str (~a))" x x))
  	      'fit-for-list #t
***************
*** 1408,1413 ****
--- 1408,1415 ----
       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 '()))
***************
*** 1464,1469 ****
--- 1466,1473 ----
    (@ "/* Generated by build-guile-gtk.  Do not edit. */~%~%")
    (@ "#include <libguile.h>~%")
    (@ "#include <guile-gtk.h>~%")
+   (@ "#include \"config.h\"~%")
+   (@ "#include \"../compat.h\"~%")
    (@ "~%")
    (for-each (lambda (info)
  	      (@ "void ~a ();~%" (car info)))
Index: guile-gtk/configure.in
===================================================================
RCS file: /cvs/gnome/gnome-guile/guile-gtk/configure.in,v
retrieving revision 1.57
diff -c -r1.57 configure.in
*** guile-gtk/configure.in	4 Jan 2002 06:52:38 -0000	1.57
--- guile-gtk/configure.in	7 Nov 2002 14:31:11 -0000
***************
*** 65,71 ****
  #  GTK_VERSION=$gtk_major_version.$gtk_minor_version
  #fi
  
! AM_PATH_GTK(1.2.0,,AC_ERROR(need at least Gtk+ version 1.2))
  
  # XXX - gtk_config_*_version leaks from AM_PATH_GTK.
  
--- 65,71 ----
  #  GTK_VERSION=$gtk_major_version.$gtk_minor_version
  #fi
  
! AM_PATH_GTK(1.2.0,,AC_ERROR(need at least Gtk+ version 1.2),gthread)
  
  # XXX - gtk_config_*_version leaks from AM_PATH_GTK.
  
***************
*** 140,146 ****
--- 140,160 ----
  	    [define if scm_eval_x takes two arguments])
  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 ###
  
  # Check for cutting edge Gtk functions
  LIBS="$GTK_LIBS $saved_LIBS"
Index: guile-gtk/gtk-support.c
===================================================================
RCS file: /cvs/gnome/gnome-guile/guile-gtk/gtk-support.c,v
retrieving revision 1.21
diff -c -r1.21 gtk-support.c
*** guile-gtk/gtk-support.c	29 Apr 2001 01:08:14 -0000	1.21
--- guile-gtk/gtk-support.c	7 Nov 2002 14:31:11 -0000
***************
*** 1,5 ****
  /*
!  * Copyright (C) 1997, 1998, 1999 Marius Vollmer
   * 
   * 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
--- 1,5 ----
  /*
!  * Copyright (C) 1997, 1998, 1999, 2001 Marius Vollmer
   * 
   * 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
***************
*** 24,29 ****
--- 24,32 ----
  #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
***************
*** 557,569 ****
    for (i = 0; i < nargs; i++)
      {
        *restail =
! 	scm_cons (scm_listify (scm_makfrom0str (args[i].name),
! 			       kw_type,
! 			       sgtk_type2scm (args[i].type),
! 			       kw_flags,
! 			       sgtk_flags2scm (arg_flags[i],
! 					       &sgtk_gtk_arg_flags_info),
! 			       SCM_UNDEFINED),
  		  SCM_EOL);
        restail = SCM_CDRLOC(*restail);
      }
--- 560,572 ----
    for (i = 0; i < nargs; i++)
      {
        *restail =
! 	scm_cons (scm_list_n (scm_makfrom0str (args[i].name),
! 			      kw_type,
! 			      sgtk_type2scm (args[i].type),
! 			      kw_flags,
! 			      sgtk_flags2scm (arg_flags[i],
! 					      &sgtk_gtk_arg_flags_info),
! 			      SCM_UNDEFINED),
  		  SCM_EOL);
        restail = SCM_CDRLOC(*restail);
      }
Index: guile-gtk/gtk-threads.c
===================================================================
RCS file: /cvs/gnome/gnome-guile/guile-gtk/gtk-threads.c,v
retrieving revision 1.3
diff -c -r1.3 gtk-threads.c
*** guile-gtk/gtk-threads.c	30 Jun 2001 01:01:34 -0000	1.3
--- guile-gtk/gtk-threads.c	7 Nov 2002 14:31:11 -0000
***************
*** 1,5 ****
  /* Threading for guile-gtk
!  * Copyright (C) 2000 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
--- 1,5 ----
  /* Threading for guile-gtk
!  * 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
***************
*** 32,39 ****
--- 32,46 ----
  
  #include "gtk-threads.h"
  
+ #define USE_THREADS 1
  #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,198 ****
  {
    int result;
  
!   result = coop_mutex_trylock ((scm_t_mutex *) mutex);
  
    if (result == EBUSY)
      return FALSE;
--- 199,205 ----
  {
    int result;
  
!   result = scm_mutex_trylock ((scm_t_mutex *) mutex);
  
    if (result == EBUSY)
      return FALSE;
***************
*** 289,302 ****
  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;
  }
--- 296,307 ----
***************
*** 311,329 ****
  			    gpointer thread)
  {
    struct spawn_data data;
    data.func = thread_func;
    data.arg = arg;
    data.thread = thread;
!   scm_spawn_thread (spawn, &data, scm_handle_by_message_noexit, 0);
  }
  
  static void
  g_thread_join_guile_impl (gpointer thread)
  {
!   coop_join (* (coop_t **) thread);
  }
  
  extern void coop_abort (void);
  
  static void
  g_thread_set_priority_guile_impl (gpointer thread, GThreadPriority priority)
--- 316,343 ----
  			    gpointer thread)
  {
    struct spawn_data data;
+   SCM t;
    data.func = thread_func;
    data.arg = arg;
    data.thread = thread;
!   t = scm_spawn_thread (spawn, &data, scm_handle_by_message_noexit, 0);
!   * (SCM *) thread = t;
  }
  
  static void
  g_thread_join_guile_impl (gpointer 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,339 ****
  static void
  g_thread_self_guile_impl (gpointer thread)
  {
!   * (coop_t **) thread = coop_global_curr;
  }
  #endif /* HAVE_THREAD_CREATE */
  
--- 347,358 ----
  static void
  g_thread_self_guile_impl (gpointer thread)
  {
! #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,364 ****
  #ifdef HAVE_THREAD_CREATE
    ,
    g_thread_create_guile_impl,
!   coop_yield,
    g_thread_join_guile_impl,
    coop_abort,
    g_thread_set_priority_guile_impl,
    g_thread_self_guile_impl
  #endif /* HAVE_THREAD_CREATE */
--- 375,387 ----
  #ifdef HAVE_THREAD_CREATE
    ,
    g_thread_create_guile_impl,
!   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/guile-gtk.c
===================================================================
RCS file: /cvs/gnome/gnome-guile/guile-gtk/guile-gtk.c,v
retrieving revision 1.69
diff -c -r1.69 guile-gtk.c
*** guile-gtk/guile-gtk.c	20 Oct 2002 00:20:52 -0000	1.69
--- guile-gtk/guile-gtk.c	7 Nov 2002 14:31:11 -0000
***************
*** 19,25 ****
   */
  #include <stdio.h>
  #include <string.h>
! #include <config.h>
  #include <assert.h>
  #ifdef GTK_2_0
  #include <gtk-2.0/gtk/gtk.h>
--- 19,25 ----
   */
  #include <stdio.h>
  #include <string.h>
! #include "config.h"
  #include <assert.h>
  #ifdef GTK_2_0
  #include <gtk-2.0/gtk/gtk.h>
***************
*** 43,48 ****
--- 43,50 ----
  
  /* Guile compatability stuff */
  
+ #include "../compat.h"
+ 
  #ifndef HAVE_SCM_DONE_MALLOC
  void scm_done_malloc (long size);
  #endif
***************
*** 555,561 ****
    return 1;
  }
  
! static scm_sizet
  gtkobj_free (SCM obj)
  {
    sgtk_object_proxy *proxy = GTKOBJ_PROXY (obj);
--- 557,563 ----
    return 1;
  }
  
! static size_t
  gtkobj_free (SCM obj)
  {
    sgtk_object_proxy *proxy = GTKOBJ_PROXY (obj);
***************
*** 1007,1013 ****
      return 0;
  
    for (i = 0; i < info->n_literals; i++)
!     if (! strcmp (info->literals[i].name, SCM_CHARS (obj)))
        return 1;
    return 0;
  }
--- 1009,1015 ----
      return 0;
  
    for (i = 0; i < info->n_literals; i++)
!     if (! strcmp (info->literals[i].name, SCM_STRING_CHARS (obj)))
        return 1;
    return 0;
  }
***************
*** 1029,1040 ****
  
    if (SCM_STRINGP (obj))
      {
!       SCM_COERCE_SUBSTR (obj);
!       return SCM_CHARS (obj);
      }
  
    for (i = 0; i < info->n_literals; i++)
!     if (! strcmp (info->literals[i].name, SCM_CHARS (obj)))
        return info->literals[i].value;
    return NULL;
  }
--- 1031,1042 ----
  
    if (SCM_STRINGP (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_STRING_CHARS (obj)))
        return info->literals[i].value;
    return NULL;
  }
***************
*** 1050,1056 ****
  #define BOXED_PTR(x)   ((gpointer)SCM_CDR(x))
  #define BOXED_INFO(x)  ((sgtk_boxed_info*)must_get_type_info(BOXED_SEQNO(x)))
  
! static scm_sizet
  boxed_free (SCM obj)
  {
    sgtk_boxed_info *info = BOXED_INFO (obj);
--- 1052,1058 ----
  #define BOXED_PTR(x)   ((gpointer)SCM_CDR(x))
  #define BOXED_INFO(x)  ((sgtk_boxed_info*)must_get_type_info(BOXED_SEQNO(x)))
  
! static size_t
  boxed_free (SCM obj)
  {
    sgtk_boxed_info *info = BOXED_INFO (obj);
***************
*** 1227,1233 ****
  GdkAtom
  sgtk_scm2atom (SCM symbol)
  {
!   return gdk_atom_intern (SCM_CHARS(symbol), FALSE);
  }
  
  SCM
--- 1229,1235 ----
  GdkAtom
  sgtk_scm2atom (SCM symbol)
  {
!   return gdk_atom_intern (SCM_STRING_CHARS(symbol), FALSE);
  }
  
  SCM
***************
*** 1349,1355 ****
  {
    return SCM_EQ_P (obj, SCM_BOOL_F) || GTKTYPEP (obj)
      || (SCM_NIMP (obj) && SCM_SYMBOLP (obj)
! 	&& sgtk_type_from_name (SCM_CHARS (obj)));
  }
  
  GtkType
--- 1351,1357 ----
  {
    return SCM_EQ_P (obj, SCM_BOOL_F) || GTKTYPEP (obj)
      || (SCM_NIMP (obj) && SCM_SYMBOLP (obj)
! 	&& sgtk_type_from_name (SCM_STRING_CHARS (obj)));
  }
  
  GtkType
***************
*** 1360,1366 ****
    else if (GTKTYPEP (obj))
      return GTKTYPE (obj);
    else
!     return sgtk_type_from_name (SCM_CHARS (obj));
  }
  
  SCM
--- 1362,1368 ----
    else if (GTKTYPEP (obj))
      return GTKTYPE (obj);
    else
!     return sgtk_type_from_name (SCM_STRING_CHARS (obj));
  }
  
  SCM
***************
*** 1457,1463 ****
        int i;
        SCM *elts;
  
!       actual_len = SCM_LENGTH (obj);
        if (len >= 0 && len != actual_len)
  	return 0;
  
--- 1459,1465 ----
        int i;
        SCM *elts;
  
!       actual_len = SCM_VECTOR_LENGTH (obj);
        if (len >= 0 && len != actual_len)
  	return 0;
  
***************
*** 1508,1514 ****
      {
        SCM vec = obj;
        SCM newvec = vec;
!       int len = SCM_LENGTH(newvec), i;
        for (i = 0; i < len; i++)
  	{
  	  SCM newelt = conversion (SCM_VELTS(newvec)[i]);
--- 1510,1516 ----
      {
        SCM vec = obj;
        SCM newvec = vec;
!       int len = SCM_VECTOR_LENGTH(newvec), i;
        for (i = 0; i < len; i++)
  	{
  	  SCM newelt = conversion (SCM_VELTS(newvec)[i]);
***************
*** 1548,1554 ****
      }
    else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
      {
!       int len = SCM_LENGTH(obj), i;
        for (i = 0; i < len; i++)
  	SCM_VELTS(obj)[i] = conversion (SCM_VELTS(obj)[i]);
        return obj;
--- 1550,1556 ----
      }
    else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
      {
!       int len = SCM_VECTOR_LENGTH(obj), i;
        for (i = 0; i < len; i++)
  	SCM_VELTS(obj)[i] = conversion (SCM_VELTS(obj)[i]);
        return obj;
***************
*** 1593,1599 ****
      }
    else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
      {
!       int len = SCM_LENGTH (obj), i;
        SCM *elts = SCM_VELTS (obj);
        for (i = 0; i < len; i++)
  	{
--- 1595,1601 ----
      }
    else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
      {
!       int len = SCM_VECTOR_LENGTH (obj), i;
        SCM *elts = SCM_VELTS (obj);
        for (i = 0; i < len; i++)
  	{
***************
*** 1628,1634 ****
  	}
        else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
  	{
! 	  int len = SCM_LENGTH (obj), i;
  	  SCM *elts = SCM_VELTS (obj);
  	  for (i = 0; i < len && list; i++)
  	    {
--- 1630,1636 ----
  	}
        else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
  	{
! 	  int len = SCM_VECTOR_LENGTH (obj), i;
  	  SCM *elts = SCM_VELTS (obj);
  	  for (i = 0; i < len && list; i++)
  	    {
***************
*** 1683,1689 ****
      }
    else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
      {
!       int len = SCM_LENGTH (obj), i;
        SCM *elts = SCM_VELTS (obj);
        for (i = 0; i < len; i++)
  	{
--- 1685,1691 ----
      }
    else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
      {
!       int len = SCM_VECTOR_LENGTH (obj), i;
        SCM *elts = SCM_VELTS (obj);
        for (i = 0; i < len; i++)
  	{
***************
*** 1724,1730 ****
  	}
        else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
  	{
! 	  int len = SCM_LENGTH (obj), i;
  	  SCM *elts = SCM_VELTS (obj);
  	  for (i = 0; i < len && list; i++)
  	    {
--- 1726,1732 ----
  	}
        else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
  	{
! 	  int len = SCM_VECTOR_LENGTH (obj), i;
  	  SCM *elts = SCM_VELTS (obj);
  	  for (i = 0; i < len && list; i++)
  	    {
***************
*** 1766,1772 ****
    else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
      {
        SCM *elts = SCM_VELTS (obj);
!       res.count = SCM_LENGTH (obj);
        res.vec = (void *)scm_must_malloc (res.count * sz, "scm2cvec");
        if (fromscm)
  	{
--- 1768,1774 ----
    else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
      {
        SCM *elts = SCM_VELTS (obj);
!       res.count = SCM_VECTOR_LENGTH (obj);
        res.vec = (void *)scm_must_malloc (res.count * sz, "scm2cvec");
        if (fromscm)
  	{
***************
*** 1803,1809 ****
        else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
  	{
  	  SCM *elts = SCM_VELTS (obj);
! 	  int len1 = SCM_LENGTH (obj), len2 = cvec->count, i;
  	  char *ptr;
  
  	  for (i = 0, ptr = cvec->vec; i < len1 && i < len2; i++, ptr += sz)
--- 1805,1811 ----
        else if (SCM_NIMP(obj) && SCM_VECTORP(obj))
  	{
  	  SCM *elts = SCM_VELTS (obj);
! 	  int len1 = SCM_VECTOR_LENGTH (obj), len2 = cvec->count, i;
  	  char *ptr;
  
  	  for (i = 0, ptr = cvec->vec; i < len1 && i < len2; i++, ptr += sz)
***************
*** 1954,1961 ****
        GTK_VALUE_DOUBLE(*a) = sgtk_scm2double (obj);
        break;
      case GTK_TYPE_STRING:
!       SCM_COERCE_SUBSTR (obj);
!       GTK_VALUE_STRING(*a) = SCM_CHARS(obj);
        break;
      case GTK_TYPE_ENUM:
        GTK_VALUE_ENUM(*a) =
--- 1956,1963 ----
        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:
        GTK_VALUE_ENUM(*a) =
***************
*** 2021,2028 ****
      case GTK_TYPE_STRING:
        SCM_ASSERT (SCM_NIMP(obj) && SCM_STRINGP(obj), obj, SCM_ARG1,
  		  "scm->gtk");
!       SCM_COERCE_SUBSTR (obj);
!       GTK_VALUE_STRING(*a) = g_strdup (SCM_CHARS(obj));
        break;
      case GTK_TYPE_ENUM:
        *GTK_RETLOC_ENUM(*a) =
--- 2023,2030 ----
      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:
        *GTK_RETLOC_ENUM(*a) =
***************
*** 2133,2139 ****
    info.n_args = n_args;
    info.args = args;
  
!   scm_internal_cwdr ((scm_catch_body_t)inner_callback_marshal, &info,
  		     scm_handle_by_message_noexit, "gtk",
  		     &stack_item);
  }
--- 2135,2141 ----
    info.n_args = n_args;
    info.args = args;
  
!   scm_internal_cwdr ((scm_t_catch_body)inner_callback_marshal, &info,
  		     scm_handle_by_message_noexit, "gtk",
  		     &stack_item);
  }
***************
*** 2160,2168 ****
        GdkColor colstruct;
        GdkColormap *colmap;
  
!       SCM_COERCE_SUBSTR (color);
        SCM_DEFER_INTS;
!       if (!gdk_color_parse (SCM_CHARS (color), &colstruct))
  	{
  	  SCM_ALLOW_INTS;
  	  scm_misc_error ("string->color",
--- 2162,2170 ----
        GdkColor colstruct;
        GdkColormap *colmap;
  
!       SCM_STRING_COERCE_0TERMINATION_X (color);
        SCM_DEFER_INTS;
!       if (!gdk_color_parse (SCM_STRING_CHARS (color), &colstruct))
  	{
  	  SCM_ALLOW_INTS;
  	  scm_misc_error ("string->color",
***************
*** 2200,2206 ****
  
    if (SCM_NIMP (font) && SCM_STRINGP (font))
      {
!       SCM_COERCE_SUBSTR (font);
        font = sgtk_gdk_font_load (font);
        if (font == SCM_BOOL_F)
  	scm_misc_error ("string->font",
--- 2202,2208 ----
  
    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",
***************
*** 2218,2224 ****
  sgtk_string_conversion (SCM str)
  {
    if (SCM_NIMP (str) && SCM_STRINGP (str))
!     SCM_COERCE_SUBSTR (str);
    return str;
  }
  
--- 2220,2226 ----
  sgtk_string_conversion (SCM str)
  {
    if (SCM_NIMP (str) && SCM_STRINGP (str))
!     SCM_STRING_COERCE_0TERMINATION_X (str);
    return str;
  }
  
***************
*** 2411,2419 ****
        scm_args = SCM_CDDR (scm_args);
  
        if (SCM_NIMP (kw) && SCM_SYMBOLP (kw))
! 	name = SCM_CHARS(kw);
        else if (SCM_NIMP (kw) && SCM_KEYWORDP (kw))
! 	name = SCM_CHARS(SCM_KEYWORDSYM(kw))+1;
        else
  	{
  	  fprintf (stderr, "bad keyword\n");
--- 2413,2421 ----
        scm_args = SCM_CDDR (scm_args);
  
        if (SCM_NIMP (kw) && SCM_SYMBOLP (kw))
! 	name = SCM_STRING_CHARS(kw);
        else if (SCM_NIMP (kw) && SCM_KEYWORDP (kw))
! 	name = SCM_STRING_CHARS(SCM_KEYWORDSYM(kw))+1;
        else
  	{
  	  fprintf (stderr, "bad keyword\n");
***************
*** 2536,2544 ****
    SCM_ASSERT (info != NULL, scm_obj, SCM_ARG1, "gtk-object-get");
  
    if (SCM_SYMBOLP(argsym))
!     name = SCM_CHARS(argsym);
    else
!     name = SCM_CHARS(SCM_KEYWORDSYM(argsym))+1;
    sgtk_find_arg_info (&arg, info, name);
  
    SCM_DEFER_INTS;
--- 2538,2546 ----
    SCM_ASSERT (info != NULL, scm_obj, SCM_ARG1, "gtk-object-get");
  
    if (SCM_SYMBOLP(argsym))
!     name = SCM_STRING_CHARS(argsym);
    else
!     name = SCM_STRING_CHARS(SCM_KEYWORDSYM(argsym))+1;
    sgtk_find_arg_info (&arg, info, name);
  
    SCM_DEFER_INTS;
***************
*** 2835,2841 ****
  	  scm_must_free ((char *)v);
  	  return;
  	}
!       v[i] = xstrdup (SCM_CHARS (SCM_CAR (list)));
      }
    v[c] = NULL;
    
--- 2837,2843 ----
  	  scm_must_free ((char *)v);
  	  return;
  	}
!       v[i] = xstrdup (SCM_STRING_CHARS (SCM_CAR (list)));
      }
    v[c] = NULL;
    
Index: guile-gtk/guiledlopenhelper.c
===================================================================
RCS file: /cvs/gnome/gnome-guile/guile-gtk/guiledlopenhelper.c,v
retrieving revision 1.10
diff -c -r1.10 guiledlopenhelper.c
*** guile-gtk/guiledlopenhelper.c	21 May 2001 02:25:52 -0000	1.10
--- guile-gtk/guiledlopenhelper.c	7 Nov 2002 14:31:11 -0000
***************
*** 1,5 ****
  /*
!  * Copyright (C) 1997, 1998, 1999 Marius Vollmer
   * 
   * 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
--- 1,5 ----
  /*
!  * Copyright (C) 1997, 1998, 1999, 2001 Marius Vollmer
   * 
   * 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
***************
*** 24,29 ****
--- 24,31 ----
  #include <dlfcn.h>
  #endif
  
+ #include "../compat.h"
+ 
  SCM
  sgtk_dlopen (SCM name, SCM fullname)
  {
***************
*** 31,41 ****
  
    SCM_ASSERT (SCM_NIMP(name) && SCM_STRINGP(name), name,
  	      SCM_ARG1, "%sgtk-dlopen");
!   SCM_COERCE_SUBSTR (name);
  
    SCM_ASSERT (SCM_NIMP(fullname) && SCM_STRINGP(fullname), fullname,
  	      SCM_ARG2, "%sgtk-dlopen");
!   SCM_COERCE_SUBSTR (fullname);
  
    SCM_DEFER_INTS;
  #ifdef HAVE_DLOPEN
--- 33,43 ----
  
    SCM_ASSERT (SCM_NIMP(name) && SCM_STRINGP(name), name,
  	      SCM_ARG1, "%sgtk-dlopen");
!   SCM_STRING_COERCE_0TERMINATION_X (name);
  
    SCM_ASSERT (SCM_NIMP(fullname) && SCM_STRINGP(fullname), fullname,
  	      SCM_ARG2, "%sgtk-dlopen");
!   SCM_STRING_COERCE_0TERMINATION_X (fullname);
  
    SCM_DEFER_INTS;
  #ifdef HAVE_DLOPEN
***************
*** 77,83 ****
    SCM_ASSERT (SCM_NIMP(sym) && SCM_STRINGP(sym), sym,
  	      SCM_ARG1, "%sgtk-dlinit");
    handle = (void *)scm_num2ulong (lib, (char *)SCM_ARG2, "%sgtk-dlinit");
!   SCM_COERCE_SUBSTR (sym);
    
    SCM_DEFER_INTS;
  #ifdef HAVE_DLOPEN
--- 79,85 ----
    SCM_ASSERT (SCM_NIMP(sym) && SCM_STRINGP(sym), sym,
  	      SCM_ARG1, "%sgtk-dlinit");
    handle = (void *)scm_num2ulong (lib, (char *)SCM_ARG2, "%sgtk-dlinit");
!   SCM_STRING_COERCE_0TERMINATION_X (sym);
    
    SCM_DEFER_INTS;
  #ifdef HAVE_DLOPEN

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: gnome-guile/compat.h --]
[-- 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 */

^ permalink raw reply	[flat|nested] 7+ messages in thread

end of thread, other threads:[~2002-11-12  3:48 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2002-11-07 14:40 guile-gtk-1.2 working with guile-1.7.0 Mikael Djurfeldt
2002-11-07 20:29 ` Marius Vollmer
2002-11-07 21:59   ` Mikael Djurfeldt
2002-11-10 21:43     ` Marius Vollmer
2002-11-10 22:04       ` Mikael Djurfeldt
2002-11-10 22:18         ` Marius Vollmer
2002-11-12  3:48       ` Mikael Djurfeldt

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).