From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Mikael Djurfeldt Newsgroups: gmane.lisp.guile.devel Subject: guile-gtk-1.2 working with guile-1.7.0 Date: 07 Nov 2002 15:40:15 +0100 Sender: guile-devel-admin@gnu.org Message-ID: Reply-To: Mikael Djurfeldt NNTP-Posting-Host: main.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: main.gmane.org 1036681307 20476 80.91.224.249 (7 Nov 2002 15:01:47 GMT) X-Complaints-To: usenet@main.gmane.org NNTP-Posting-Date: Thu, 7 Nov 2002 15:01:47 +0000 (UTC) Cc: djurfeldt@nada.kth.se, Ariel Rios , guile-devel@gnu.org Return-path: Original-Received: from monty-python.gnu.org ([199.232.76.173]) by main.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 189oAA-0005Jl-00 for ; Thu, 07 Nov 2002 16:01:42 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.10) id 189o4M-0005Yx-00; Thu, 07 Nov 2002 09:55:42 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.10) id 189npk-0007ij-00 for guile-devel@gnu.org; Thu, 07 Nov 2002 09:40:36 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.10) id 189npe-0007iB-00 for guile-devel@gnu.org; Thu, 07 Nov 2002 09:40:35 -0500 Original-Received: from kvast.blakulla.net ([213.212.20.77]) by monty-python.gnu.org with esmtp (Exim 4.10) id 189npd-0007hT-00 for guile-devel@gnu.org; Thu, 07 Nov 2002 09:40:29 -0500 Original-Received: from dyna224-221.nada.kth.se ([130.237.224.221] helo=linnaeus) by kvast.blakulla.net with esmtp (Exim 3.36 #1 (Debian)) id 189npT-0004hM-00; Thu, 07 Nov 2002 15:40:19 +0100 Original-Received: from mdj by linnaeus with local (Exim 3.36 #1 (Debian)) id 189npR-0002dK-00; Thu, 07 Nov 2002 15:40:17 +0100 Original-To: marius.vollmer@uni-dortmund.de Original-Lines: 10 Errors-To: guile-devel-admin@gnu.org X-BeenThere: guile-devel@gnu.org X-Mailman-Version: 2.0.11 Precedence: bulk List-Help: List-Post: List-Subscribe: , List-Id: Developers list for Guile, the GNU extensibility library List-Unsubscribe: , List-Archive: Xref: main.gmane.org gmane.lisp.guile.devel:1656 X-Report-Spam: http://spam.gmane.org/gmane.lisp.guile.devel:1656 --=-=-= 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. --=-=-= Content-Disposition: attachment; filename=guile-gtk-1.7.diff Content-Description: Diff against gnome-guile source tree ? 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 + + * compat.h: New file. + + * Makefile.am (EXTRA_DIST): Added compat.h. + 2002-01-03 Ariel Rios * 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 + + 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 * 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 ~%") (@ "#include ~%") + (@ "#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 ~%") (@ "#include ~%") + (@ "#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 ], + [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 #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 #include ! #include #include #ifdef GTK_2_0 #include --- 19,25 ---- */ #include #include ! #include "config.h" #include #ifdef GTK_2_0 #include *************** *** 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 #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 --=-=-= Content-Type: text/x-chdr Content-Disposition: attachment; filename=compat.h Content-Description: gnome-guile/compat.h /* 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. */ #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 */ --=-=-=-- _______________________________________________ Guile-devel mailing list Guile-devel@gnu.org http://mail.gnu.org/mailman/listinfo/guile-devel