From: Mikael Djurfeldt <mdj@kvast.blakulla.net>
Cc: djurfeldt@nada.kth.se, Ariel Rios <ariel@arcavia.com>,
guile-devel@gnu.org
Subject: guile-gtk-1.2 working with guile-1.7.0
Date: 07 Nov 2002 15:40:15 +0100 [thread overview]
Message-ID: <xy74rata1f4.fsf@linnaeus.i-did-not-set--mail-host-address--so-shoot-me> (raw)
[-- 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 */
next reply other threads:[~2002-11-07 14:40 UTC|newest]
Thread overview: 7+ messages / expand[flat|nested] mbox.gz Atom feed top
2002-11-07 14:40 Mikael Djurfeldt [this message]
2002-11-07 20:29 ` guile-gtk-1.2 working with guile-1.7.0 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
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/guile/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=xy74rata1f4.fsf@linnaeus.i-did-not-set--mail-host-address--so-shoot-me \
--to=mdj@kvast.blakulla.net \
--cc=ariel@arcavia.com \
--cc=djurfeldt@nada.kth.se \
--cc=guile-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).