Update to allow building with --disable-deprecated Guile
Andreas Rottmann <[email protected]> Wed, 04 May 2011 02:13:02 +0200
| Newsgroups | gmane.lisp.guile.gtk |
|---|---|
| Message-ID | <[email protected]> |
Hi! Just a heads-up: I've an incomplete (and rough), but already comprehensive patch (or rather patches) for guile-gnome-platform outstanding that will allow it to build against Guile when the latter is compiled with --disable-deprecated. I've attached what I have so far. This is the output of "./scripts/for-each-pkg git diff HEAD", so don't expect to be able to apply it without manual fiddling with the file paths. Regards, Rotty -- Andreas Rottmann -- <http://rotty.yi.org/> _______________________________________________ guile-gtk-general mailing list [email protected] https://lists.gnu.org/mailman/listinfo/guile-gtk-general
+without-deprecated.patch
(text/x-diff, 64.6 KB)
* for-each-pkg in /home/rotty/src/guile-gnome-platform
* atk: git 'diff' 'HEAD'
* cairo: git 'diff' 'HEAD'
* corba: git 'diff' 'HEAD'
diff --git a/gnome/corba/guile-gnome-corba-generic.c b/gnome/corba/guile-gnome-corba-generic.c
index 9515e6b..fe3418b 100644
--- a/gnome/corba/guile-gnome-corba-generic.c
+++ b/gnome/corba/guile-gnome-corba-generic.c
@@ -68,7 +68,7 @@ guile_corba_generic_make_type_name (const gchar *StudlyCaps)
"gtype-name->class-name"));
}
- ret = scm_call_1 (de_studly_capsify, scm_makfrom0str (StudlyCaps));
+ ret = scm_call_1 (de_studly_capsify, scm_from_locale_string (StudlyCaps));
return scm_to_locale_string (scm_symbol_to_string (ret));
}
diff --git a/gnome/corba/guile-gnome-corba-primitives.c b/gnome/corba/guile-gnome-corba-primitives.c
index 0b63ff3..209cab1 100644
--- a/gnome/corba/guile-gnome-corba-primitives.c
+++ b/gnome/corba/guile-gnome-corba-primitives.c
@@ -89,8 +89,8 @@ make_scm_module_name (const gchar *module_name)
parts = g_strsplit (module_name, ":", 0);
for (ptr = parts; *ptr; ptr++)
- scm_name = scm_append_x (SCM_LIST2 (scm_name, SCM_LIST1 (
- scm_str2symbol (*ptr))));
+ scm_name = scm_append_x (scm_list_2 (scm_name, scm_list_1 (
+ scm_from_locale_symbol (*ptr))));
g_strfreev (parts);
return scm_name;
@@ -115,32 +115,32 @@ scm_c_corba_handle_exception (CORBA_Environment *ev)
{
SCM name;
- name = scm_mem2string (ev->_id, strlen (ev->_id));
+ name = scm_from_locale_stringn (ev->_id, strlen (ev->_id));
if (ev->_major == CORBA_SYSTEM_EXCEPTION) {
CORBA_SystemException *se = CORBA_exception_value (ev);
SCM minor, completed;
- minor = scm_long2num (se->minor);;
+ minor = scm_from_long (se->minor);;
switch (se->completed) {
case CORBA_COMPLETED_YES:
- completed = scm_str2symbol ("completed");
+ completed = scm_from_locale_symbol ("completed");
break;
case CORBA_COMPLETED_NO:
- completed = scm_str2symbol ("not-completed");
+ completed = scm_from_locale_symbol ("not-completed");
break;
default:
- completed = scm_str2symbol ("maybe-completed");
+ completed = scm_from_locale_symbol ("maybe-completed");
break;
}
CORBA_exception_free (ev);
scm_ithrow (scm_sym_corba_system_exception,
- SCM_LIST3 (name, minor, completed), 1);
+ scm_list_3 (name, minor, completed), 1);
} else {
CORBA_exception_free (ev);
- scm_ithrow (scm_sym_corba_user_exception, SCM_LIST1 (name), 1);
+ scm_ithrow (scm_sym_corba_user_exception, scm_list_1 (name), 1);
}
}
@@ -218,14 +218,14 @@ case CORBA_tk_ ## k: \
retval = ## f (*(CORBA_ ## t *) value); \
break;
- _HANDLE_BASIC_VALUE (short, short, scm_short2num);
- _HANDLE_BASIC_VALUE (long, long, scm_long2num);
- _HANDLE_BASIC_VALUE (ushort, unsigned_short, scm_int2num);
- _HANDLE_BASIC_VALUE (ulong, unsigned_long, scm_ulong2num);
+ _HANDLE_BASIC_VALUE (short, short, scm_from_short);
+ _HANDLE_BASIC_VALUE (long, long, scm_from_long);
+ _HANDLE_BASIC_VALUE (ushort, unsigned_short, scm_from_int);
+ _HANDLE_BASIC_VALUE (ulong, unsigned_long, scm_from_ulong);
_HANDLE_BASIC_VALUE (longlong, long_long, scm_long_long2num);
_HANDLE_BASIC_VALUE (ulonglong, unsigned_long_long, scm_long_long2num);
- _HANDLE_BASIC_VALUE (float, float, scm_float2num);
- _HANDLE_BASIC_VALUE (double, double, scm_double2num);
+ _HANDLE_BASIC_VALUE (float, float, scm_from_double);
+ _HANDLE_BASIC_VALUE (double, double, scm_from_double);
#undef _HANDLE_BASIC_VALUE
}
@@ -320,7 +320,7 @@ SCM_DEFINE (scm_corba_primitive_make_poa_instance, "corba-primitive-make-poa-ins
SCM_NEWSMOB (smob, scm_tc16_guile_portable_server_servant, servant);
- object = scm_make (SCM_LIST1 (class));
+ object = scm_make (scm_list_1 (class));
scm_slot_set_x (object, scm_sym_servant, smob);
gservant->this = object;
@@ -338,7 +338,7 @@ repo_id_to_symbol (const gchar *format, const gchar *repo_id)
SCM retval;
new_repo_id = guile_corba_generic_repo_id_to_name (format, repo_id);
- retval = scm_mem2symbol (new_repo_id, strlen (new_repo_id));
+ retval = scm_from_locale_symboln (new_repo_id, strlen (new_repo_id));
g_free (new_repo_id);
return retval;
}
@@ -414,7 +414,7 @@ scm_c_generic_skel_func (PortableServer_ServantBase *servant,
imethod = (ORBit_IMethod *) SCM_SMOB_DATA (scm_c_vector_ref (poa_vector, 1));
generic = scm_c_vector_ref (poa_vector, 3);
- args = SCM_LIST1 (gservant->this);
+ args = scm_list_1 (gservant->this);
length = imethod->arguments._length;
if (length) length--;
@@ -425,7 +425,7 @@ scm_c_generic_skel_func (PortableServer_ServantBase *servant,
SCM value;
value = scm_c_corba_demarshal_any (&any);
- args = scm_append_x (SCM_LIST2 (args, SCM_LIST1 (value)));
+ args = scm_append_x (scm_list_2 (args, scm_list_1 (value)));
}
func = scm_compute_applicable_methods (generic, args, scm_ilength (args), 1);
@@ -541,10 +541,10 @@ guile_corba_sys_register_interface (ORBit_IInterface *iinterface)
SCM_NEWSMOB (iinterface_smob, scm_tc16_guile_corba_interface, interface);
poa_meta_class = scm_class_portable_server_servant_base;
- poa_parent_classes = SCM_LIST1 (poa_meta_class);
+ poa_parent_classes = scm_list_1 (poa_meta_class);
stub_meta_class = scm_class_corba_object;
- stub_parent_classes = SCM_LIST1 (stub_meta_class);
+ stub_parent_classes = scm_list_1 (stub_meta_class);
for (i = 0; i < length; i++) {
GuileCorbaInterface *base_interface;
@@ -561,10 +561,10 @@ guile_corba_sys_register_interface (ORBit_IInterface *iinterface)
interface->vepv [i+1] = (PortableServer_ServantBase__epv *) base_interface->epv;
poa_meta_class = base_interface->poa_class;
- poa_parent_classes = scm_append_x (SCM_LIST2 (SCM_LIST1 (poa_meta_class), poa_parent_classes));
+ poa_parent_classes = scm_append_x (scm_list_2 (scm_list_1 (poa_meta_class), poa_parent_classes));
stub_meta_class = base_interface->stub_class;
- stub_parent_classes = scm_append_x (SCM_LIST2 (SCM_LIST1 (stub_meta_class), stub_parent_classes));
+ stub_parent_classes = scm_append_x (scm_list_2 (scm_list_1 (stub_meta_class), stub_parent_classes));
for (j = 0; j < base_interface->iinterface->methods._length; j++) {
ORBit_IMethod *imethod = &base_interface->iinterface->methods._buffer [j];
@@ -576,7 +576,7 @@ guile_corba_sys_register_interface (ORBit_IInterface *iinterface)
stub_class = scm_apply (_scm_make_class,
scm_cons2 (stub_parent_classes, SCM_EOL,
- SCM_LIST4 (k_name, stub_class_name,
+ scm_list_4 (k_name, stub_class_name,
k_metaclass, stub_meta_class)),
SCM_EOL);
@@ -587,7 +587,7 @@ guile_corba_sys_register_interface (ORBit_IInterface *iinterface)
poa_class = scm_apply (_scm_make_class,
scm_cons2 (poa_parent_classes, SCM_EOL,
- SCM_LIST4 (k_name, poa_class_name,
+ scm_list_4 (k_name, poa_class_name,
k_metaclass, poa_meta_class)),
SCM_EOL);
@@ -623,7 +623,7 @@ guile_corba_sys_register_interface (ORBit_IInterface *iinterface)
method_proc = scm_call_3 (make_method, method_gsubr,
scm_symbol_to_string (method_name), imethod_smob);
- specializers = SCM_LIST1 (stub_class);
+ specializers = scm_list_1 (stub_class);
num_args = imethod->arguments._length;
if (num_args) --num_args;
@@ -633,14 +633,14 @@ guile_corba_sys_register_interface (ORBit_IInterface *iinterface)
SCM class;
class = scm_c_corba_typecode_to_class (arg->tc);
- specializers = scm_append_x (SCM_LIST2 (specializers, SCM_LIST1 (class)));
+ specializers = scm_append_x (scm_list_2 (specializers, scm_list_1 (class)));
}
- method = scm_make (SCM_LIST3 (scm_class_generic,
+ method = scm_make (scm_list_3 (scm_class_generic,
k_name, method_name));
scm_call_2 (add_method, method,
- scm_make (SCM_LIST5 (scm_class_method,
+ scm_make (scm_list_5 (scm_class_method,
k_procedure, method_proc,
k_specializers, specializers)));
scm_define (method_name, method);
diff --git a/gnome/corba/guile-gnome-corba-types.c b/gnome/corba/guile-gnome-corba-types.c
index dce2c77..55aa439 100644
--- a/gnome/corba/guile-gnome-corba-types.c
+++ b/gnome/corba/guile-gnome-corba-types.c
@@ -57,14 +57,14 @@ print_corba_struct (SCM corba_struct, SCM port)
CORBA_TypeCode tc;
gchar *message;
- printer = SCM_PACK (SCM_STRUCT_DATA (corba_struct) [scm_vtable_index_printer]);
+ printer = SCM_PACK (SCM_STRUCT_DATA (corba_struct) [scm_vtable_index_instance_printer]);
if (SCM_NIMP (printer) && scm_procedure_p (printer))
return scm_call_2 (printer, corba_struct, port);
tc = SCM_CORBA_STRUCT_TYPECODE (corba_struct);
message = g_strdup_printf ("<CORBA-struct %p - %s>", corba_struct, tc->repo_id);
- retval = scm_simple_format (port, scm_makfrom0str (message), SCM_EOL);
+ retval = scm_simple_format (port, scm_from_locale_string (message), SCM_EOL);
g_free (message);
return retval;
@@ -77,14 +77,14 @@ print_corba_sequence (SCM corba_sequence, SCM port)
CORBA_TypeCode tc;
gchar *message;
- printer = SCM_PACK (SCM_STRUCT_DATA (corba_sequence) [scm_vtable_index_printer]);
+ printer = SCM_PACK (SCM_STRUCT_DATA (corba_sequence) [scm_vtable_index_instance_printer]);
if (SCM_NIMP (printer) && scm_procedure_p (printer))
return scm_call_2 (printer, corba_sequence, port);
tc = SCM_CORBA_SEQUENCE_TYPECODE (corba_sequence);
message = g_strdup_printf ("<CORBA-sequence %p - %s>", corba_sequence, tc->subtypes [0]->repo_id);
- retval = scm_simple_format (port, scm_makfrom0str (message), SCM_EOL);
+ retval = scm_simple_format (port, scm_from_locale_string (message), SCM_EOL);
g_free (message);
return retval;
@@ -105,8 +105,8 @@ SCM_DEFINE (scm_corba_struct_fields, "corba-struct-fields", 1, 0, 0,
fields = SCM_EOL;
for (i = 0; i < tc->sub_parts; i++) {
- SCM sym = scm_mem2symbol (tc->subnames [i], strlen (tc->subnames [i]));
- fields = scm_append_x (SCM_LIST2 (fields, SCM_LIST1 (sym)));
+ SCM sym = scm_from_locale_symboln (tc->subnames [i], strlen (tc->subnames [i]));
+ fields = scm_append_x (scm_list_2 (fields, scm_list_1 (sym)));
}
return fields;
@@ -489,7 +489,7 @@ case CORBA_tk_ ## k: \
}
case CORBA_tk_string:
- retval = scm_mem2string (* (CORBA_char **) any->_value,
+ retval = scm_from_locale_stringn (* (CORBA_char **) any->_value,
strlen (* (CORBA_char **) any->_value));
break;
@@ -666,7 +666,7 @@ guile_corba_typecode_print (SCM typecode_smob, SCM port, scm_print_state *pstate
CORBA_TypeCode tc = (CORBA_TypeCode) SCM_SMOB_DATA (typecode_smob);
scm_puts ("#<CORBA-TypeCode ", port);
- scm_display (scm_makfrom0str (tc->repo_id), port);
+ scm_display (scm_from_locale_string (tc->repo_id), port);
scm_puts (">", port);
/* non-zero means success */
@@ -709,7 +709,7 @@ scm_c_make_corba_object (SCM class, CORBA_Object corba_objref)
ORBit_RootObject_duplicate (corba_objref);
SCM_NEWSMOB (smob, scm_tc16_corba_object, corba_objref);
- object = scm_make (SCM_LIST1 (class));
+ object = scm_make (scm_list_1 (class));
scm_slot_set_x (object, scm_sym_corba_objref, smob);
return object;
@@ -814,19 +814,19 @@ scm_init_gnome_corba_types (void)
gsubr = scm_c_make_gsubr ("%print-corba-struct", 2, 0, 0, print_corba_struct);
scm_corba_struct_vtable = scm_permanent_object
- (scm_make_vtable_vtable (scm_makfrom0str ("srprprprpopopW"), scm_from_int (0), SCM_LIST1 (gsubr)));
+ (scm_make_vtable_vtable (scm_from_locale_string ("srprprprpopopW"), scm_from_int (0), scm_list_1 (gsubr)));
SCM_SET_CORBA_STRUCT_TYPECODE (scm_corba_struct_vtable, TC_CORBA_TypeCode);
scm_c_define ("%corba-struct-vtable", scm_corba_struct_vtable);
scm_c_define ("%corba-struct-vtable-offset-user", scm_from_int (scm_corba_struct_vtable_offset_user));
- scm_c_define ("%corba-struct-vtable-offset-printer", scm_from_int (scm_vtable_index_printer));
+ scm_c_define ("%corba-struct-vtable-offset-printer", scm_from_int (scm_vtable_index_instance_printer));
gsubr = scm_c_make_gsubr ("%print-corba-sequence", 2, 0, 0, print_corba_sequence);
scm_corba_sequence_vtable = scm_permanent_object
- (scm_make_vtable_vtable (scm_makfrom0str ("srprprprpopW"), scm_from_int (0), SCM_LIST1 (gsubr)));
+ (scm_make_vtable_vtable (scm_from_locale_string ("srprprprpopW"), scm_from_int (0), scm_list_1 (gsubr)));
SCM_SET_CORBA_SEQUENCE_TYPECODE (scm_corba_sequence_vtable, TC_CORBA_TypeCode);
scm_c_define ("%corba-sequence-vtable", scm_corba_sequence_vtable);
scm_c_define ("%corba-sequence-vtable-offset-user", scm_from_int (scm_corba_sequence_vtable_offset_user));
- scm_c_define ("%corba-sequence-vtable-offset-printer", scm_from_int (scm_vtable_index_printer));
+ scm_c_define ("%corba-sequence-vtable-offset-printer", scm_from_int (scm_vtable_index_instance_printer));
scm_c_export ("%corba-struct-vtable",
"%corba-struct-vtable-offset-user",
diff --git a/gnome/corba/types.scm b/gnome/corba/types.scm
index bec438c..b22d641 100644
--- a/gnome/corba/types.scm
+++ b/gnome/corba/types.scm
@@ -1,6 +1,7 @@
;; guile-gnome
;; Copyright (C) 2001 Martin Baulig <[email protected]>
;; 2003,2004 Andy Wingo <wingo at pobox dot com>
+;; 2011 Andreas Rottmann <[email protected]>
;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
@@ -31,7 +32,6 @@
:use-module (oop goops))
(define (gnome-corba-error format-string . args)
- (save-stack)
(scm-error 'gnome-corba-error #f format-string args '()))
(%init-gnome-corba-types)
* defs: git 'diff' 'HEAD'
diff --git a/gnome/defs/gtk.defs b/gnome/defs/gtk.defs
index 8ae6ec4..75f5d2c 100644
--- a/gnome/defs/gtk.defs
+++ b/gnome/defs/gtk.defs
@@ -16160,7 +16160,7 @@
(return-type "gboolean")
(parameters
'("const-gchar*" "app_name")
- '("gchar**" "app_exec")
+ '("const-gchar**" "app_exec")
'("guint*" "count")
'("time_t*" "time_")
)
* gconf: git 'diff' 'HEAD'
diff --git a/gnome/gw/gconf-support.c b/gnome/gw/gconf-support.c
index 698fedc..6fe019a 100644
--- a/gnome/gw/gconf-support.c
+++ b/gnome/gw/gconf-support.c
@@ -1,5 +1,5 @@
/* guile-gnome
- * Copyright (C) 2004 Free Software Foundation, Inc.
+ * Copyright (C) 2004, 2011 Free Software Foundation, Inc.
*
* gconf-support.c: Support routines for the gconf wrapper
*
@@ -26,8 +26,8 @@
#include "guile-gnome-gobject.h"
#define GRUNTIME_ERROR(format, func_name, args...) \
- scm_error_scm (scm_str2symbol ("gruntime-error"), scm_makfrom0str (func_name), \
- scm_simple_format (SCM_BOOL_F, scm_makfrom0str (format), \
+ scm_error_scm (scm_from_locale_symbol ("gruntime-error"), scm_from_locale_string (func_name), \
+ scm_simple_format (SCM_BOOL_F, scm_from_locale_string (format), \
scm_list_n (args, SCM_UNDEFINED)), \
SCM_EOL, SCM_EOL)
@@ -57,15 +57,15 @@ SCM
scm_c_gconf_value_to_scm (const GConfValue *value)
{
if (!value)
- scm_throw (scm_str2symbol ("value-unset"), SCM_EOL);
+ scm_throw (scm_from_locale_symbol ("value-unset"), SCM_EOL);
switch (value->type) {
case GCONF_VALUE_STRING:
- return scm_makfrom0str (gconf_value_get_string (value));
+ return scm_from_locale_string (gconf_value_get_string (value));
case GCONF_VALUE_INT:
- return scm_int2num (gconf_value_get_int (value));
+ return scm_from_int (gconf_value_get_int (value));
case GCONF_VALUE_FLOAT:
- return scm_float2num (gconf_value_get_float (value));
+ return scm_from_double (gconf_value_get_float (value));
case GCONF_VALUE_BOOL:
return SCM_BOOL (gconf_value_get_bool (value));
case GCONF_VALUE_SCHEMA:
@@ -81,14 +81,14 @@ scm_c_gconf_value_to_scm (const GConfValue *value)
for (walk = head; walk; walk = walk->next) {
switch (t) {
case GCONF_VALUE_STRING:
- ret = scm_cons (scm_makfrom0str ((char*)walk->data), ret);
+ ret = scm_cons (scm_from_locale_string ((char*)walk->data), ret);
g_free (walk->data);
break;
case GCONF_VALUE_INT:
- ret = scm_cons (scm_int2num (GPOINTER_TO_INT (walk->data)), ret);
+ ret = scm_cons (scm_from_int (GPOINTER_TO_INT (walk->data)), ret);
break;
case GCONF_VALUE_FLOAT:
- ret = scm_cons (scm_float2num (*(float*)walk->data), ret);
+ ret = scm_cons (scm_from_double (*(float*)walk->data), ret);
g_free (walk->data);
break;
case GCONF_VALUE_BOOL:
@@ -100,8 +100,8 @@ scm_c_gconf_value_to_scm (const GConfValue *value)
ret);
break;
default:
- scm_throw (scm_str2symbol ("unknown-value"),
- SCM_LIST1 (scm_from_int (t)));
+ scm_throw (scm_from_locale_symbol ("unknown-value"),
+ scm_list_1 (scm_from_int (t)));
}
}
g_slist_free (head);
@@ -111,8 +111,8 @@ scm_c_gconf_value_to_scm (const GConfValue *value)
return scm_cons (scm_c_gconf_value_to_scm (gconf_value_get_car (value)),
scm_c_gconf_value_to_scm (gconf_value_get_cdr (value)));
default:
- scm_throw (scm_str2symbol ("unknown-value"),
- SCM_LIST1 (scm_from_int (value->type)));
+ scm_throw (scm_from_locale_symbol ("unknown-value"),
+ scm_list_1 (scm_from_int (value->type)));
}
return SCM_BOOL_F; /* shouldn't get here */
}
@@ -185,15 +185,15 @@ scm_c_scm_to_gconf_value (SCM value)
ret = gconf_value_new (GCONF_VALUE_INT);
gconf_value_set_int (ret, scm_to_int (value));
} else if (SCM_NFALSEP (scm_exact_p (value))) {
- if (SCM_NFALSEP (scm_leq_p (value, scm_uint2num (G_MAXINT)))) {
+ if (SCM_NFALSEP (scm_leq_p (value, scm_from_uint (G_MAXINT)))) {
ret = gconf_value_new (GCONF_VALUE_INT);
- gconf_value_set_int (ret, scm_num2int (value, 1, FUNC_NAME));
+ gconf_value_set_int (ret, scm_to_int (value));
} else {
scm_misc_error (FUNC_NAME, "Invalid value: ~A", scm_list_1 (value));
}
} else if (SCM_NFALSEP (scm_inexact_p (value))) {
ret = gconf_value_new (GCONF_VALUE_FLOAT);
- gconf_value_set_float (ret, scm_num2float (value, 1, FUNC_NAME));
+ gconf_value_set_float (ret, scm_to_double (value));
} else if (scm_is_string (value)) {
char *chars;
ret = gconf_value_new (GCONF_VALUE_STRING);
@@ -235,7 +235,7 @@ with_notify_proc (GConfClient *client, guint cnxn_id, GConfEntry *entry,
proc = GPOINTER_TO_SCM (user_data);
sclient = scm_c_gtype_instance_to_scm ((GTypeInstance*)client);
- key = scm_str2symbol (gconf_entry_get_key (entry));
+ key = scm_from_locale_symbol (gconf_entry_get_key (entry));
val = scm_c_gconf_value_to_scm (gconf_entry_get_value (entry));
scm_call_4 (proc, sclient, scm_from_uint (cnxn_id), key, val);
* glib: git 'diff' 'HEAD'
diff --git a/gnome/gobject/gobject.c b/gnome/gobject/gobject.c
index 1a8a891..5a6653a 100644
--- a/gnome/gobject/gobject.c
+++ b/gnome/gobject/gobject.c
@@ -78,7 +78,7 @@ scm_with_c_gobject_get_property (GObject *gobject, guint param_id,
scm_c_gvalue_set (dest_gvalue,
scm_call_2 (_gobject_get_property,
scm_c_gtype_instance_to_scm (gobject),
- scm_str2symbol (pspec->name)));
+ scm_from_locale_symbol (pspec->name)));
}
static void
@@ -94,7 +94,7 @@ scm_with_c_gobject_set_property (GObject *gobject, guint param_id, const GValue
{
scm_call_3 (_gobject_set_property,
scm_c_gtype_instance_to_scm (gobject),
- scm_str2symbol (pspec->name),
+ scm_from_locale_symbol (pspec->name),
scm_c_gvalue_to_scm (src_value));
}
@@ -188,7 +188,7 @@ scm_c_gobject_construct (SCM instance, SCM initargs)
if (!pspec)
scm_c_gruntime_error (FUNC_NAME,
"No property named ~S in object ~A",
- SCM_LIST2 (propname, instance));
+ scm_list_2 (propname, instance));
g_value_init (¤t->value, G_PARAM_SPEC_VALUE_TYPE (pspec));
scm_c_gvalue_set (¤t->value, val);
@@ -352,17 +352,17 @@ SCM_DEFINE (scm_gtype_register_static, "gtype-register-static", 2, 0, 0,
if (gtype)
scm_c_gruntime_error (FUNC_NAME,
"There is already a type with this name: ~S",
- SCM_LIST1 (name));
+ scm_list_1 (name));
if (!G_TYPE_IS_DERIVABLE (gtype_parent))
scm_c_gruntime_error (FUNC_NAME,
"Cannot derive ~S from non-derivable parent type: ~S",
- SCM_LIST2 (name, parent_class));
+ scm_list_2 (name, parent_class));
if (!G_TYPE_IS_FUNDAMENTAL (gtype_parent) && !G_TYPE_IS_DEEP_DERIVABLE (gtype_parent))
scm_c_gruntime_error (FUNC_NAME,
"Cannot derive ~S from non-fundamental parent type: ~S",
- SCM_LIST2 (name, parent_class));
+ scm_list_2 (name, parent_class));
g_type_query (gtype_parent, >ype_query);
@@ -490,18 +490,18 @@ SCM_DEFINE (scm_gobject_class_install_property, "gobject-class-install-property"
if (g_object_class_find_property (gclass, gparam->name))
scm_error (sym_gruntime_error, FUNC_NAME,
"There is already a property with this name in class ~S: ~S",
- SCM_LIST2 (class, scm_makfrom0str (gparam->name)), SCM_EOL);
+ scm_list_2 (class, scm_from_locale_string (gparam->name)), SCM_EOL);
guile_class = g_type_get_qdata (gtype, quark_guile_gtype_class);
if (!guile_class)
scm_error (sym_gruntime_error, FUNC_NAME,
"Can't add properties to non-derived type: ~S",
- SCM_LIST1 (class), SCM_EOL);
+ scm_list_1 (class), SCM_EOL);
if (guile_class->first_instance_created)
scm_error (sym_gruntime_error, FUNC_NAME,
"Can't add properties after intances have been created: ~S",
- SCM_LIST1 (class), SCM_EOL);
+ scm_list_1 (class), SCM_EOL);
id = ++guile_class->last_property_id;
g_object_class_install_property (gclass, id, gparam);
@@ -536,7 +536,7 @@ SCM_DEFINE (scm_gobject_get_property, "gobject-get-property", 2, 0, 0,
if (!pspec)
scm_error (sym_gruntime_error, FUNC_NAME,
"No such property ~S in class ~S",
- SCM_LIST2 (name, scm_class_of (object)), SCM_EOL);
+ scm_list_2 (name, scm_class_of (object)), SCM_EOL);
g_value_init (&value, pspec->value_type);
g_object_get_property (gobject, pspec->name, &value);
@@ -571,7 +571,7 @@ SCM_DEFINE (scm_gobject_set_property, "gobject-set-property", 3, 0, 0,
if (!pspec)
scm_error (sym_gruntime_error, FUNC_NAME,
"No such property ~S in class ~S",
- SCM_LIST2 (name, scm_class_of (object)), SCM_EOL);
+ scm_list_2 (name, scm_class_of (object)), SCM_EOL);
gvalue = scm_c_scm_to_gvalue (pspec->value_type, value);
g_object_set_property (gobject, pspec->name, gvalue);
diff --git a/gnome/gobject/gparameter.c b/gnome/gobject/gparameter.c
index 782ac30..82e5da2 100644
--- a/gnome/gobject/gparameter.c
+++ b/gnome/gobject/gparameter.c
@@ -33,7 +33,7 @@
#define SCM_ERROR_NOT_YET_IMPLEMENTED(what) \
scm_c_gruntime_error (FUNC_NAME, "Not yet implemented: file ~S line ~S: ~A", \
- SCM_LIST3 (scm_makfrom0str (__FILE__), scm_from_uint (__LINE__), what))
+ scm_list_3 (scm_from_locale_string (__FILE__), scm_from_uint (__LINE__), what))
@@ -395,7 +395,7 @@ scm_c_gparam_construct (SCM instance, SCM initargs)
else {
scm_c_gruntime_error ("%gparam-construct",
"Can't create instance of ~A from initargs: ~A",
- SCM_LIST2 (scm_class_of (instance), initargs));
+ scm_list_2 (scm_class_of (instance), initargs));
}
DEBUG_ALLOC ("new guile-owned param spec %p of type %s",
diff --git a/gnome/gobject/gsignal.c b/gnome/gobject/gsignal.c
index 59bccc4..e9062a2 100644
--- a/gnome/gobject/gsignal.c
+++ b/gnome/gobject/gsignal.c
@@ -94,7 +94,7 @@ SCM_DEFINE (scm_gsignal_query, "gsignal-query", 2, 0, 0,
free (cname);
if (!id)
scm_c_gruntime_error (FUNC_NAME, "Unknown signal ~A on class ~A",
- SCM_LIST2 (name, class));
+ scm_list_2 (name, class));
return scm_c_gsignal_query (id);
}
@@ -206,7 +206,7 @@ SCM_DEFINE (scm_gtype_instance_signal_emit, "gtype-instance-signal-emit", 2, 0,
if (!id)
scm_c_gruntime_error (FUNC_NAME, "Unknown signal ~A on object ~A",
- SCM_LIST2 (name, object));
+ scm_list_2 (name, object));
g_signal_query (id, &query);
diff --git a/gnome/gobject/gtype.c b/gnome/gobject/gtype.c
index 7c5438b..86f7780 100644
--- a/gnome/gobject/gtype.c
+++ b/gnome/gobject/gtype.c
@@ -189,7 +189,7 @@ SCM_DEFINE (scm_gtype_name_to_class, "gtype-name->class", 1, 0, 0,
if (!type)
scm_c_gruntime_error (FUNC_NAME,
"No GType registered with name ~A",
- SCM_LIST1 (name));
+ scm_list_1 (name));
scm_dynwind_end ();
@@ -208,7 +208,7 @@ gtype_struct_offset (SCM class)
scm_c_gruntime_error ("%gtype-class-bind",
"`gtype' not allocated a slot in struct!",
- SCM_LIST1 (class));
+ scm_list_1 (class));
return -1;
}
@@ -238,13 +238,13 @@ SCM_DEFINE_STATIC (scm_sys_gtype_class_bind, "%gtype-class-bind", 2, 0, 0,
if (!gtype)
scm_c_gruntime_error (FUNC_NAME,
"No GType registered with name ~A",
- SCM_LIST1 (type_name));
+ scm_list_1 (type_name));
if (SCM_NFALSEP (scm_c_gtype_lookup_class (gtype)))
scm_c_gruntime_error (FUNC_NAME,
"~A already has a GOOPS class, use gtype-name->class",
- SCM_LIST1 (type_name));
+ scm_list_1 (type_name));
g_type_set_qdata (gtype, quark_class, scm_permanent_object (class));
slots = SCM_STRUCT_DATA (class);
@@ -298,7 +298,7 @@ SCM_DEFINE_STATIC (scm_sys_gtype_class_inherit_magic, "%gtype-class-inherit-magi
SCM_STRUCT_DATA (parent)[scm_vtable_index_instance_finalize];
} else {
scm_c_gruntime_error (FUNC_NAME, "No free function for SCM class %s!",
- SCM_LIST1 (class));
+ scm_list_1 (class));
#else
} else {
SCM parent = scm_cadr (scm_class_precedence_list (class));
@@ -455,7 +455,7 @@ scm_c_gtype_instance_construct (SCM object, SCM initargs)
else
scm_c_gruntime_error ("%gtype-instance-construct",
"Don't know how to construct instances of class ~A",
- SCM_LIST1 (scm_c_gtype_to_class (type)));
+ scm_list_1 (scm_c_gtype_to_class (type)));
return NULL;
}
@@ -613,14 +613,14 @@ scm_c_scm_to_gtype_instance (SCM instance)
if (ulong == SCM_UNBOUND)
scm_c_gruntime_error ("%scm->gtype-instance",
"Object ~A is uninitialized.",
- SCM_LIST1 (instance));
+ scm_list_1 (instance));
ginstance = (gpointer)scm_to_ulong (ulong);
if (!ginstance)
scm_c_gruntime_error ("%scm->gtype-instance",
"Object ~A has been destroyed.",
- SCM_LIST1 (instance));
+ scm_list_1 (instance));
return ginstance;
}
diff --git a/gnome/gobject/gtype.scm b/gnome/gobject/gtype.scm
index dcf7baf..5b0ef21 100644
--- a/gnome/gobject/gtype.scm
+++ b/gnome/gobject/gtype.scm
@@ -57,7 +57,6 @@
(define (gruntime-error format-string . args)
"Signal a runtime error. The error will be thrown to the key
@code{gruntime-error}."
- (save-stack)
(scm-error 'gruntime-error #f format-string args '()))
diff --git a/gnome/gobject/guile-support.c b/gnome/gobject/guile-support.c
index 7461ab9..3c7d02d 100644
--- a/gnome/gobject/guile-support.c
+++ b/gnome/gobject/guile-support.c
@@ -25,22 +25,6 @@
#include <string.h>
-#ifndef SCM_VERSION_17X
-
-SCM
-scm_str2string (const char *src)
-{
- return scm_mem2string (src, strlen (src));
-}
-
-void *
-scm_with_guile (void*(*func)(void*), void *data)
-{
- return func(data);
-}
-
-#endif
-
char*
scm_to_locale_string_dynwind (SCM s)
{
diff --git a/gnome/gobject/guile-support.h b/gnome/gobject/guile-support.h
index a77599d..d30ec89 100644
--- a/gnome/gobject/guile-support.h
+++ b/gnome/gobject/guile-support.h
@@ -30,29 +30,8 @@
G_BEGIN_DECLS
-/* Define this macro if Guile 1.7.x or better is in use. */
-#if defined (SCM_MINOR_VERSION) && (SCM_MINOR_VERSION >= 7) && \
- defined (SCM_MAJOR_VERSION) && (SCM_MAJOR_VERSION >= 1)
-#define SCM_VERSION_17X 1
-#endif
-
-/* Support for coding against Guile 1.7 */
-#ifndef SCM_VERSION_17X
-
-#define scm_gc_malloc(size, what) scm_must_malloc((size), (what))
-#define scm_gc_free(mem, size, what) \
- do{ scm_must_free (mem); scm_done_free (size); } while (0)
-
-#define SCM_VECTOR_SET(x, idx, val) (SCM_VELTS(x)[(idx)] = (val))
-#define SCM_VECTOR_REF(x, idx) (SCM_VELTS(x)[(idx)])
-
-#define scm_gc_register_collectable_memory(mem, size, what)
-#define scm_gc_unregister_collectable_memory(mem, size, what)
-
-void *scm_with_guile (void*(*func)(void*), void *data);
-
-SCM scm_str2string (const char *src);
-
+#if SCM_MAJOR_VERSION < 2
+#define scm_vtable_index_instance_printer scm_vtable_index_printer
#endif
char* scm_to_locale_string_dynwind (SCM s);
diff --git a/gnome/gobject/gutil.c b/gnome/gobject/gutil.c
index 8906eb4..e775551 100644
--- a/gnome/gobject/gutil.c
+++ b/gnome/gobject/gutil.c
@@ -1,5 +1,5 @@
/* guile-gnome
- * Copyright (C) 2005 Andreas Rottmann
+ * Copyright (C) 2005, 2011 Andreas Rottmann
*
* gutil.c: Some GLib-related utilties
*
@@ -26,9 +26,9 @@
SCM
scm_c_gerror_to_scm (GError *error)
{
- return scm_list_3 (scm_ulong2num(error->domain),
- scm_ulong2num(error->code),
- scm_makfrom0str(error->message));
+ return scm_list_3 (scm_from_ulong(error->domain),
+ scm_from_ulong(error->code),
+ scm_from_locale_string(error->message));
}
void
@@ -36,5 +36,5 @@ scm_c_raise_gerror (GError *error)
{
SCM scm_gerror = scm_c_gerror_to_scm (error);
g_error_free (error);
- scm_throw (scm_str2symbol("g-error"), scm_gerror);
+ scm_throw (scm_from_locale_symbol("g-error"), scm_gerror);
}
diff --git a/gnome/gobject/gvalue.c b/gnome/gobject/gvalue.c
index fbdd23a..4b00e95 100644
--- a/gnome/gobject/gvalue.c
+++ b/gnome/gobject/gvalue.c
@@ -237,10 +237,10 @@ scm_c_gvalue_ref (const GValue *gvalue)
return scm_from_ulong_long (g_value_get_uint64 (gvalue));
case G_TYPE_FLOAT:
- return scm_make_real ((double) g_value_get_float (gvalue));
+ return scm_from_double ((double) g_value_get_float (gvalue));
case G_TYPE_DOUBLE:
- return scm_make_real (g_value_get_double (gvalue));
+ return scm_from_double (g_value_get_double (gvalue));
case G_TYPE_STRING:
{
@@ -289,7 +289,7 @@ scm_c_gvalue_set (GValue *gvalue, SCM value)
return;
} else {
scm_c_gruntime_error (FUNC_NAME, "Can't make ~a into ~a",
- SCM_LIST2 (value, scm_c_gtype_to_class (gtype)));
+ scm_list_2 (value, scm_c_gtype_to_class (gtype)));
return;
}
}
@@ -339,14 +339,14 @@ scm_c_gvalue_set (GValue *gvalue, SCM value)
break;
case G_TYPE_FLOAT: {
- double x = scm_num2dbl (value, FUNC_NAME);
+ double x = scm_to_double (value);
SCM_ASSERT_RANGE (2, value, (- G_MAXFLOAT < x) && (x < G_MAXFLOAT));
g_value_set_float (gvalue, (float) x);
break;
}
case G_TYPE_DOUBLE:
- g_value_set_double (gvalue, scm_num2dbl (value, FUNC_NAME));
+ g_value_set_double (gvalue, scm_to_double (value));
break;
case G_TYPE_STRING:
@@ -405,7 +405,7 @@ scm_c_gvalue_set (GValue *gvalue, SCM value)
scm_c_gruntime_error (FUNC_NAME,
"Don't know how to make values of type ~A",
- SCM_LIST1 (scm_c_gtype_to_class (gtype)));
+ scm_list_1 (scm_c_gtype_to_class (gtype)));
}
}
#undef FUNC_NAME
@@ -419,7 +419,7 @@ scm_c_scm_to_enum_value (GEnumClass *enum_class, SCM value)
#define ERROR(x) \
scm_c_gruntime_error \
(FUNC_NAME, "Bad enum value for enumerated type `~a': ~a", \
- SCM_LIST2 (scm_from_locale_string \
+ scm_list_2 (scm_from_locale_string \
(g_type_name (G_TYPE_FROM_CLASS (enum_class))), x))
if (scm_is_signed_integer (value, SCM_T_INT32_MIN, SCM_T_INT32_MAX)) {
@@ -473,7 +473,7 @@ scm_c_scm_to_flags_value (GFlagsClass *flags_class, SCM value)
#define ERROR(x) \
scm_c_gruntime_error \
(FUNC_NAME, "Bad value for flags type `~a': ~a", \
- SCM_LIST2 (scm_from_locale_string \
+ scm_list_2 (scm_from_locale_string \
(g_type_name (G_TYPE_FROM_CLASS (flags_class))), x))
if (scm_is_unsigned_integer (value, 0, SCM_T_UINT32_MAX)) {
@@ -753,7 +753,7 @@ SCM_DEFINE (scm_genum_register_static, "genum-register-static", 2, 0, 0,
if (type)
scm_c_gruntime_error (FUNC_NAME,
"There is already a type with this name: ~S",
- SCM_LIST1 (name));
+ scm_list_1 (name));
length = scm_c_vector_length (vtable);
@@ -807,7 +807,7 @@ SCM_DEFINE (scm_gflags_register_static, "gflags-register-static", 2, 0, 0,
if (type)
scm_c_gruntime_error (FUNC_NAME,
"There is already a type with this name: ~S",
- SCM_LIST1 (name));
+ scm_list_1 (name));
length = scm_c_vector_length (vtable);
diff --git a/gnome/gw/glib-support.c b/gnome/gw/glib-support.c
index 1cf1e3c..53bc2d9 100644
--- a/gnome/gw/glib-support.c
+++ b/gnome/gw/glib-support.c
@@ -29,7 +29,7 @@
#include <g-wrap/guile-wct.h>
#define GRUNTIME_ERROR(format, func_name, args...) \
- scm_error (scm_str2symbol ("gruntime-error"), func_name, format, \
+ scm_error (scm_from_locale_symbol ("gruntime-error"), func_name, format, \
##args, SCM_EOL)
size_t
@@ -260,7 +260,7 @@ _wrap_g_main_loop_run (GMainLoop *loop)
SCM
_wrap_g_string_get_str (GString *str)
{
- return scm_mem2string (str->str, str->len);
+ return scm_from_locale_stringn (str->str, str->len);
}
struct io_args {
@@ -277,7 +277,7 @@ _with_io_func (gpointer data)
result = scm_call_2 (args->proc,
gw_wcp_assimilate_ptr (args->source, iochannel_type),
- scm_long2num (args->condition));
+ scm_from_long (args->condition));
return result != SCM_BOOL_F ? (void*)1 : (void*)0;
}
diff --git a/gnome/gw/support/gobject.scm b/gnome/gw/support/gobject.scm
index 699bf05..712a0a8 100644
--- a/gnome/gw/support/gobject.scm
+++ b/gnome/gw/support/gobject.scm
@@ -1054,6 +1054,7 @@ example:
;;; We override the generation of the scheme wrapper, because we want to
;;; avoid listing all exports of the module. See the lengthy comment in
;;; guile/g-wrap/guile-runtime.c in g-wrap for a rationale.
+#;
(define-method (generate-wrapset (lang <symbol>)
(wrapset <gobject-wrapset-base>)
(basename <string>))
diff --git a/shlib-dirs.ac b/shlib-dirs.ac
index 299461e..a529aed 100644
--- a/shlib-dirs.ac
+++ b/shlib-dirs.ac
@@ -1,2 +1,3 @@
gnome/gw
gnome/gobject
+test-suite
diff --git a/test-suite/guile-gobject-test b/test-suite/guile-gobject-test
index c0c2a9e..f7aa523 100755
--- a/test-suite/guile-gobject-test
+++ b/test-suite/guile-gobject-test
@@ -7,7 +7,7 @@ exec ${srcdir:-.}/guile-test-env guile --debug -e main -s "$0" "$@"
;;;; Stolen for guile-gobject by Andreas Rottmann <[email protected]>
;;;; --- Oct 2003
;;;;
-;;;; Copyright (C) 1999 - 2003 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999 - 2003, 2011 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
@@ -93,6 +93,7 @@ exec ${srcdir:-.}/guile-test-env guile --debug -e main -s "$0" "$@"
#:use-module (ice-9 getopt-long)
#:use-module (ice-9 and-let-star)
#:use-module (ice-9 rdelim)
+ #:use-module (srfi srfi-13)
#:export (main data-file-name test-file-name))
@@ -165,7 +166,7 @@ exec ${srcdir:-.}/guile-test-env guile --debug -e main -s "$0" "$@"
(let ((root-len (+ 1 (string-length test-dir)))
(tests '()))
(for-each-file (lambda (file)
- (if (has-suffix? file ".test")
+ (if (string-suffix? ".test" file)
(let ((short-name
(substring file root-len)))
(set! tests (cons short-name tests))))
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 46da7e1..b63c595 100644
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -1,31 +1,45 @@
;;;; test-suite/lib.scm --- generic support for testing
-;;;; Copyright (C) 1999, 2000, 2001 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007, 2009, 2010,
+;;;; 2011 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 free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Lesser General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 3, 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.
+;;;; GNU Lesser 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
+;;;; You should have received a copy of the GNU Lesser General Public
+;;;; License along with this software; see the file COPYING.LESSER.
+;;;; If not, write to the Free Software Foundation, Inc., 51 Franklin
+;;;; Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite lib)
- :use-module (ice-9 stack-catch)
- :use-module (ice-9 regex)
- :export (
+ #:use-module (ice-9 stack-catch)
+ #:use-module (ice-9 regex)
+ #:autoload (srfi srfi-1) (append-map)
+ #:autoload (system base compile) (compile)
+ #:export (
;; Exceptions which are commonly being tested for.
+ exception:syntax-pattern-unmatched
exception:bad-variable
exception:missing-expression
exception:out-of-range exception:unbound-var
+ exception:used-before-defined
exception:wrong-num-args exception:wrong-type-arg
+ exception:numerical-overflow
+ exception:struct-set!-denied
+ exception:system-error
+ exception:encoding-error
+ exception:miscellaneous-error
+ exception:string-contains-nul
+ exception:read-error
+ exception:null-pointer-error
+ exception:vm-error
;; Reporting passes and failures.
run-test
@@ -33,9 +47,18 @@
pass-if-exception expect-fail-exception
;; Naming groups of tests in a regular fashion.
- with-test-prefix with-test-prefix* current-test-prefix
+ with-test-prefix
+ with-test-prefix*
+ with-test-prefix/c&e
+ current-test-prefix
format-test-name
+ ;; Using the debugging evaluator.
+ with-debugging-evaluator with-debugging-evaluator*
+
+ ;; Using a given locale
+ with-locale with-locale* with-latin1-locale with-latin1-locale*
+
;; Reporting results in various ways.
register-reporter unregister-reporter reporter-registered?
make-count-reporter print-counts
@@ -155,7 +178,7 @@
;;;; ("basic arithmetic" "subtraction"), and
;;;; ("multiplication").
;;;;
-;;;; WITH-TEST-PREFIX can be nested. Each WITH-TEST-PREFIX postpends
+;;;; WITH-TEST-PREFIX can be nested. Each WITH-TEST-PREFIX appends
;;;; a new element to the current prefix:
;;;;
;;;; (with-test-prefix "arithmetic"
@@ -234,18 +257,43 @@
;;;;
;;; Define some exceptions which are commonly being tested for.
+(define exception:syntax-pattern-unmatched
+ (cons 'syntax-error "source expression failed to match any pattern"))
(define exception:bad-variable
(cons 'syntax-error "Bad variable"))
(define exception:missing-expression
(cons 'misc-error "^missing or extra expression"))
(define exception:out-of-range
- (cons 'out-of-range "^Argument .*out of range"))
+ (cons 'out-of-range "^.*out of range"))
(define exception:unbound-var
(cons 'unbound-variable "^Unbound variable"))
+(define exception:used-before-defined
+ (cons 'unbound-variable "^Variable used before given a value"))
(define exception:wrong-num-args
(cons 'wrong-number-of-args "^Wrong number of arguments"))
(define exception:wrong-type-arg
- (cons 'wrong-type-arg "^Wrong type argument"))
+ (cons 'wrong-type-arg "^Wrong type"))
+(define exception:numerical-overflow
+ (cons 'numerical-overflow "^Numerical overflow"))
+(define exception:struct-set!-denied
+ (cons 'misc-error "^set! denied for field"))
+(define exception:system-error
+ (cons 'system-error ".*"))
+(define exception:encoding-error
+ (cons 'encoding-error "(cannot convert to output locale|input (locale conversion|decoding) error)"))
+(define exception:miscellaneous-error
+ (cons 'misc-error "^.*"))
+(define exception:read-error
+ (cons 'read-error "^.*$"))
+(define exception:null-pointer-error
+ (cons 'null-pointer-error "^.*$"))
+(define exception:vm-error
+ (cons 'vm-error "^.*$"))
+
+;; as per throw in scm_to_locale_stringn()
+(define exception:string-contains-nul
+ (cons 'misc-error "^string contains #\\\\nul character"))
+
;;; Display all parameters to the default output port, followed by a newline.
(define (display-line . objs)
@@ -293,20 +341,24 @@
(set! run-test local-run-test))
;;; A short form for tests that are expected to pass, taken from Greg.
-(defmacro pass-if (name . rest)
- (if (and (null? rest) (pair? name))
- ;; presume this is a simple test, i.e. (pass-if (even? 2))
- ;; where the body should also be the name.
- `(run-test ',name #t (lambda () ,name))
- `(run-test ,name #t (lambda () ,@rest))))
+(define-syntax pass-if
+ (syntax-rules ()
+ ((_ name)
+ ;; presume this is a simple test, i.e. (pass-if (even? 2))
+ ;; where the body should also be the name.
+ (run-test 'name #t (lambda () name)))
+ ((_ name rest ...)
+ (run-test name #t (lambda () rest ...)))))
;;; A short form for tests that are expected to fail, taken from Greg.
-(defmacro expect-fail (name . rest)
- (if (and (null? rest) (pair? name))
- ;; presume this is a simple test, i.e. (expect-fail (even? 2))
- ;; where the body should also be the name.
- `(run-test ',name #f (lambda () ,name))
- `(run-test ,name #f (lambda () ,@rest))))
+(define-syntax expect-fail
+ (syntax-rules ()
+ ((_ name)
+ ;; presume this is a simple test, i.e. (expect-fail (even? 2))
+ ;; where the body should also be the name.
+ (run-test 'name #f (lambda () name)))
+ ((_ name rest ...)
+ (run-test name #f (lambda () rest ...)))))
;;; A helper function to implement the macros that test for exceptions.
(define (run-test-exception name exception expect-pass thunk)
@@ -338,12 +390,16 @@
(apply throw key proc message rest))))))))
;;; A short form for tests that expect a certain exception to be thrown.
-(defmacro pass-if-exception (name exception body . rest)
- `(,run-test-exception ,name ,exception #t (lambda () ,body ,@rest)))
+(define-syntax pass-if-exception
+ (syntax-rules ()
+ ((_ name exception body rest ...)
+ (run-test-exception name exception #t (lambda () body rest ...)))))
;;; A short form for tests expected to fail to throw a certain exception.
-(defmacro expect-fail-exception (name exception body . rest)
- `(,run-test-exception ,name ,exception #f (lambda () ,body ,@rest)))
+(define-syntax expect-fail-exception
+ (syntax-rules ()
+ ((_ name exception body rest ...)
+ (run-test-exception name exception #f (lambda () body rest ...)))))
;;;; TEST NAMES
@@ -351,15 +407,18 @@
;;;; Turn a test name into a nice human-readable string.
(define (format-test-name name)
- (call-with-output-string
- (lambda (port)
- (let loop ((name name)
- (separator ""))
- (if (pair? name)
- (begin
- (display separator port)
- (display (car name) port)
- (loop (cdr name) ": ")))))))
+ ;; Choose a Unicode-capable encoding so that the string port can contain any
+ ;; valid Unicode character.
+ (with-fluids ((%default-port-encoding "UTF-8"))
+ (call-with-output-string
+ (lambda (port)
+ (let loop ((name name)
+ (separator ""))
+ (if (pair? name)
+ (begin
+ (display separator port)
+ (display (car name) port)
+ (loop (cdr name) ": "))))))))
;;;; For a given test-name, deliver the full name including all prefixes.
(define (full-name name)
@@ -384,8 +443,97 @@
;;; The name prefix is only changed within the dynamic scope of the
;;; with-test-prefix expression. Return the value returned by the last
;;; BODY expression.
-(defmacro with-test-prefix (prefix . body)
- `(with-test-prefix* ,prefix (lambda () ,@body)))
+(define-syntax with-test-prefix
+ (syntax-rules ()
+ ((_ prefix body ...)
+ (with-test-prefix* prefix (lambda () body ...)))))
+
+(define-syntax c&e
+ (syntax-rules (pass-if pass-if-exception)
+ "Run the given tests both with the evaluator and the compiler/VM."
+ ((_ (pass-if test-name exp))
+ (begin (pass-if (string-append test-name " (eval)")
+ (primitive-eval 'exp))
+ (pass-if (string-append test-name " (compile)")
+ (compile 'exp #:to 'value #:env (current-module)))))
+ ((_ (pass-if-exception test-name exc exp))
+ (begin (pass-if-exception (string-append test-name " (eval)")
+ exc (primitive-eval 'exp))
+ (pass-if-exception (string-append test-name " (compile)")
+ exc (compile 'exp #:to 'value
+ #:env (current-module)))))))
+
+;;; (with-test-prefix/c&e PREFIX BODY ...)
+;;; Same as `with-test-prefix', but the enclosed tests are run both with
+;;; the compiler/VM and the evaluator.
+(define-syntax with-test-prefix/c&e
+ (syntax-rules ()
+ ((_ section-name exp ...)
+ (with-test-prefix section-name (c&e exp) ...))))
+
+;;; Call THUNK using the debugging evaluator.
+(define (with-debugging-evaluator* thunk)
+ (let ((dopts #f))
+ (dynamic-wind
+ (lambda ()
+ (set! dopts (debug-options)))
+ thunk
+ (lambda ()
+ (debug-options dopts)))))
+
+;;; Evaluate BODY... using the debugging evaluator.
+(define-macro (with-debugging-evaluator . body)
+ `(with-debugging-evaluator* (lambda () ,@body)))
+
+;;; Call THUNK with a given locale
+(define (with-locale* nloc thunk)
+ (let ((loc #f))
+ (dynamic-wind
+ (lambda ()
+ (if (defined? 'setlocale)
+ (begin
+ (set! loc (false-if-exception (setlocale LC_ALL)))
+ (if (or (not loc)
+ (not (false-if-exception (setlocale LC_ALL nloc))))
+ (throw 'unresolved)))
+ (throw 'unresolved)))
+ thunk
+ (lambda ()
+ (if (and (defined? 'setlocale) loc)
+ (setlocale LC_ALL loc))))))
+
+;;; Evaluate BODY... using the given locale.
+(define-syntax with-locale
+ (syntax-rules ()
+ ((_ loc body ...)
+ (with-locale* loc (lambda () body ...)))))
+
+;;; Try out several ISO-8859-1 locales and run THUNK under the one that works
+;;; (if any).
+(define (with-latin1-locale* thunk)
+ (define %locales
+ (append-map (lambda (name)
+ (list (string-append name ".ISO-8859-1")
+ (string-append name ".iso88591")
+ (string-append name ".ISO8859-1")))
+ '("ca_ES" "da_DK" "de_DE" "es_ES" "es_MX" "en_GB" "en_US"
+ "fr_FR" "pt_PT" "nl_NL" "sv_SE")))
+
+ (let loop ((locales %locales))
+ (if (null? locales)
+ (throw 'unresolved)
+ (catch 'unresolved
+ (lambda ()
+ (with-locale* (car locales) thunk))
+ (lambda (key . args)
+ (loop (cdr locales)))))))
+
+;;; Evaluate BODY... using an ISO-8859-1 locale or throw `unresolved' if none
+;;; was found.
+(define-syntax with-latin1-locale
+ (syntax-rules ()
+ ((_ body ...)
+ (with-latin1-locale* (lambda () body ...)))))
;;;; REPORTERS
* gnome-vfs: git 'diff' 'HEAD'
diff --git a/gnome/gw/gnome-vfs-port.c b/gnome/gw/gnome-vfs-port.c
index 1075317..d4249fe 100644
--- a/gnome/gw/gnome-vfs-port.c
+++ b/gnome/gw/gnome-vfs-port.c
@@ -1,5 +1,5 @@
/* guile-gnome
- * Copyright (C) 2004, 2009 Free Software Foundation, Inc.
+ * Copyright (C) 2004, 2009, 2011 Free Software Foundation, Inc.
*
* gnome-vfs-support.c: Support routines for the gnome-vfs wrapper
*
@@ -28,48 +28,13 @@
#include <string.h>
-/* Define this macro if Guile 1.7.x or better is in use. */
-#if defined (SCM_MINOR_VERSION) && (SCM_MINOR_VERSION >= 7) && \
- defined (SCM_MAJOR_VERSION) && (SCM_MAJOR_VERSION >= 1)
-#define SCM_VERSION_17X 1
-#endif
-
#if SCM_MAJOR_VERSION == 1 && SCM_MINOR_VERSION < 9
typedef off_t scm_t_off;
#endif
-/* Support for coding against Guile 1.7 */
-#ifndef SCM_VERSION_17X
-
-#define scm_gc_malloc(size, what) scm_must_malloc((size), (what))
-#define scm_gc_free(mem, size, what) \
- do{ scm_must_free (mem); scm_done_free (size); } while (0)
-
-#define LOCK SCM_DEFER_INTS
-#define UNLOCK SCM_ALLOW_INTS
-
-static SCM
-scm_new_port_table_entry (scm_t_bits tag)
-#define FUNC_NAME "scm_new_port_table_entry"
-{
- SCM port;
- scm_t_port *pt;
-
- SCM_NEWCELL (port);
- pt = scm_add_to_port_table (port);
- SCM_SET_CELL_TYPE(port, tag);
- SCM_SETPTAB_ENTRY (port, pt);
- return port;
-}
-#undef FUNC_NAME
-
-#else /* SCM_VERSION_17X */
-
#define LOCK scm_i_pthread_mutex_lock (&scm_i_port_table_mutex)
#define UNLOCK scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex)
-#endif /* SCM_VERSION_17X */
-
static scm_t_bits scm_tc16_vport = 0;
#define CHECK_RESULT(res) \
@@ -150,7 +115,7 @@ scm_gnome_vfs_handle_to_port (GnomeVFSHandle *handle, GnomeVFSOpenMode mode,
scm_vport_buffer_add (port, 0, 0);
else
scm_vport_buffer_add (port, -1, -1);
- SCM_SET_FILENAME (port, scm_makfrom0str (uri));
+ SCM_SET_FILENAME (port, scm_from_locale_string (uri));
UNLOCK;
diff --git a/gnome/gw/gnome-vfs-support.h b/gnome/gw/gnome-vfs-support.h
index 5469803..d0c7198 100644
--- a/gnome/gw/gnome-vfs-support.h
+++ b/gnome/gw/gnome-vfs-support.h
@@ -26,12 +26,12 @@
#include "guile-gnome-gobject.h"
#define RESULT_ERROR(result) \
- scm_throw (scm_str2symbol ("gnome-vfs-error"), \
+ scm_throw (scm_from_locale_symbol ("gnome-vfs-error"), \
scm_list_1 \
- (scm_str2symbol (g_enum_get_value \
- ((GEnumClass*)g_type_class_peek \
- (GNOME_VFS_TYPE_VFS_RESULT), \
- result)->value_nick)))
+ (scm_from_locale_symbol (g_enum_get_value \
+ ((GEnumClass*)g_type_class_peek \
+ (GNOME_VFS_TYPE_VFS_RESULT), \
+ result)->value_nick)))
GnomeVFSDirectoryHandle *_wrap_gnome_vfs_directory_open (const gchar *text_uri, GnomeVFSFileInfoOptions options);
GnomeVFSDirectoryHandle *_wrap_gnome_vfs_directory_open_from_uri (GnomeVFSURI *uri, GnomeVFSFileInfoOptions options);
* gtk: git 'diff' 'HEAD'
diff --git a/gnome/gw/gdk-support.c b/gnome/gw/gdk-support.c
index f0ed87f..716f6ed 100644
--- a/gnome/gw/gdk-support.c
+++ b/gnome/gw/gdk-support.c
@@ -43,7 +43,7 @@ gdk_event_to_vector (GdkEvent *event)
VSET (ret, 0, scm_from_int (event->type));
VSET (ret, 1, scm_c_gtype_instance_to_scm (ekey.window));
VSET (ret, 2, ekey.send_event ? SCM_BOOL_T : SCM_BOOL_F);
- VSET (ret, 3, scm_ulong2num (ekey.time));
+ VSET (ret, 3, scm_from_ulong (ekey.time));
VSET (ret, 4, scm_from_int (ekey.state));
VSET (ret, 5, scm_from_int (ekey.keyval));
VSET (ret, 6, scm_from_int (ekey.hardware_keycode));
@@ -64,14 +64,14 @@ gdk_event_to_vector (GdkEvent *event)
VSET (ret, 0, scm_from_int (event->type));
VSET (ret, 1, scm_c_gtype_instance_to_scm (ebutton.window));
VSET (ret, 2, ebutton.send_event ? SCM_BOOL_T : SCM_BOOL_F);
- VSET (ret, 3, scm_ulong2num (ebutton.time));
- VSET (ret, 4, scm_double2num (ebutton.x));
- VSET (ret, 5, scm_double2num (ebutton.y));
+ VSET (ret, 3, scm_from_ulong (ebutton.time));
+ VSET (ret, 4, scm_from_double (ebutton.x));
+ VSET (ret, 5, scm_from_double (ebutton.y));
VSET (ret, 6, scm_from_int (ebutton.state));
VSET (ret, 7, scm_from_int (ebutton.button));
VSET (ret, 8, scm_c_gtype_instance_to_scm (ebutton.device));
- VSET (ret, 9, scm_double2num (ebutton.x_root));
- VSET (ret, 10, scm_double2num (ebutton.y_root));
+ VSET (ret, 9, scm_from_double (ebutton.x_root));
+ VSET (ret, 10, scm_from_double (ebutton.y_root));
return ret;
}
case GDK_ENTER_NOTIFY:
@@ -92,11 +92,11 @@ gdk_event_to_vector (GdkEvent *event)
else
VSET (ret, 3, SCM_BOOL_F);
- VSET (ret, 4, scm_ulong2num (ecrossing.time));
- VSET (ret, 5, scm_double2num (ecrossing.x));
- VSET (ret, 6, scm_double2num (ecrossing.y));
- VSET (ret, 7, scm_double2num (ecrossing.x_root));
- VSET (ret, 8, scm_double2num (ecrossing.y_root));
+ VSET (ret, 4, scm_from_ulong (ecrossing.time));
+ VSET (ret, 5, scm_from_double (ecrossing.x));
+ VSET (ret, 6, scm_from_double (ecrossing.y));
+ VSET (ret, 7, scm_from_double (ecrossing.x_root));
+ VSET (ret, 8, scm_from_double (ecrossing.y_root));
VSET (ret, 9, scm_from_int (ecrossing.mode));
VSET (ret, 10, scm_from_int (ecrossing.detail));
VSET (ret, 11, SCM_BOOL (ecrossing.focus));
@@ -116,10 +116,10 @@ gdk_event_to_vector (GdkEvent *event)
VSET (ret, 0, scm_from_int (event->type));
VSET (ret, 1, scm_c_gtype_instance_to_scm (eselection.window));
VSET (ret, 2, eselection.send_event ? SCM_BOOL_T : SCM_BOOL_F);
- VSET (ret, 3, scm_take0str (gdk_atom_name (eselection.selection)));
- VSET (ret, 4, scm_take0str (gdk_atom_name (eselection.target)));
- VSET (ret, 5, scm_take0str (gdk_atom_name (eselection.property)));
- VSET (ret, 6, scm_ulong2num (eselection.time));
+ VSET (ret, 3, scm_take_locale_string (gdk_atom_name (eselection.selection)));
+ VSET (ret, 4, scm_take_locale_string (gdk_atom_name (eselection.target)));
+ VSET (ret, 5, scm_take_locale_string (gdk_atom_name (eselection.property)));
+ VSET (ret, 6, scm_from_ulong (eselection.time));
VSET (ret, 7, scm_from_int (eselection.requestor));
return ret;
@@ -135,15 +135,15 @@ gdk_event_to_vector (GdkEvent *event)
VSET (ret, 0, scm_from_int (event->type));
VSET (ret, 1, scm_c_gtype_instance_to_scm (emotion.window));
VSET (ret, 2, emotion.send_event ? SCM_BOOL_T : SCM_BOOL_F);
- VSET (ret, 3, scm_ulong2num (emotion.time));
- VSET (ret, 4, scm_double2num (emotion.x));
- VSET (ret, 5, scm_double2num (emotion.y));
+ VSET (ret, 3, scm_from_ulong (emotion.time));
+ VSET (ret, 4, scm_from_double (emotion.x));
+ VSET (ret, 5, scm_from_double (emotion.y));
VSET (ret, 6, scm_from_int (emotion.state));
VSET (ret, 7, emotion.is_hint ? SCM_BOOL_T : SCM_BOOL_F);
VSET (ret, 8,
scm_c_gtype_instance_to_scm (emotion.device));
- VSET (ret, 9, scm_double2num (emotion.x_root));
- VSET (ret, 10, scm_double2num (emotion.y_root));
+ VSET (ret, 9, scm_from_double (emotion.x_root));
+ VSET (ret, 10, scm_from_double (emotion.y_root));
return ret;
}
case GDK_WINDOW_STATE:
@@ -212,7 +212,7 @@ scm_scm_to_gdk_rectangle (SCM scm)
GdkRectangle *ret = gdk_rectangle_new ();
#define GET_VINT(v,i) \
- scm_num2int (scm_vector_ref (v, scm_from_int(i)), 0, FUNC_NAME)
+ scm_to_int (scm_vector_ref (v, scm_from_int(i)))
ret->x = GET_VINT (scm, 0);
ret->y = GET_VINT (scm, 1);
@@ -228,9 +228,9 @@ scm_gdk_color_to_scm (GdkColor *c)
{
SCM ret = scm_c_make_vector (3, SCM_BOOL_F);
- VSET (ret, 0, scm_ushort2num (c->red));
- VSET (ret, 1, scm_ushort2num (c->green));
- VSET (ret, 2, scm_ushort2num (c->blue));
+ VSET (ret, 0, scm_from_ushort (c->red));
+ VSET (ret, 1, scm_from_ushort (c->green));
+ VSET (ret, 2, scm_from_ushort (c->blue));
return ret;
}
@@ -265,7 +265,7 @@ scm_scm_to_gdk_color (SCM scm)
}
#define GET_VUSHORT(v,i) \
- scm_num2ushort (scm_vector_ref (v, scm_from_int (i)), 0, FUNC_NAME)
+ scm_to_ushort (scm_vector_ref (v, scm_from_int (i)))
ret->red = GET_VUSHORT (scm, 0);
ret->green = GET_VUSHORT (scm, 1);
diff --git a/gnome/gw/gtk-support.c b/gnome/gw/gtk-support.c
index e6bc9c6..3336ad8 100644
--- a/gnome/gw/gtk-support.c
+++ b/gnome/gw/gtk-support.c
@@ -508,7 +508,7 @@ _wrap_gtk_stock_lookup (const gchar *stock_id)
GtkStockItem item;
if (gtk_stock_lookup (stock_id, &item)) {
- return SCM_LIST5 (scm_from_locale_string (item.stock_id),
+ return scm_list_5 (scm_from_locale_string (item.stock_id),
scm_from_locale_string (item.label),
scm_from_uint (item.modifier),
scm_from_uint (item.keyval),
@@ -1012,7 +1012,7 @@ gtk_widget_get_window (GtkWidget *widget)
}
GdkRectangle*
-gtk_widget_get_allocation (GtkWidget *widget)
+_gtk_widget_get_allocation (GtkWidget *widget)
{
GdkRectangle *ret = g_new (GdkRectangle, 1);
*ret = widget->allocation;
diff --git a/gnome/gw/gtk-support.h b/gnome/gw/gtk-support.h
index 0326cd1..79009c0 100644
--- a/gnome/gw/gtk-support.h
+++ b/gnome/gw/gtk-support.h
@@ -117,6 +117,6 @@ void _wrap_gtk_tree_view_column_set_cell_data_func (GtkTreeViewColumn *tree_colu
guint _wrap_gtk_ui_manager_add_ui_from_string (GtkUIManager *ui, const gchar *string, GError **error);
GdkWindow* gtk_widget_get_window (GtkWidget *widget);
-GdkRectangle* gtk_widget_get_allocation (GtkWidget *widget);
+GdkRectangle* _gtk_widget_get_allocation (GtkWidget *widget);
void _wrap_gtk_drag_dest_set (GtkWidget *widget, GtkDestDefaults flags, const GList *types, GdkDragAction actions);
GtkStateType gtk_widget_get_state (GtkWidget *widget);
diff --git a/gnome/overrides/gtk.defs b/gnome/overrides/gtk.defs
index e69a5a2..e914f70 100644
--- a/gnome/overrides/gtk.defs
+++ b/gnome/overrides/gtk.defs
@@ -848,7 +848,8 @@
(define-method get-allocation
(of-object "GtkWidget")
- (c-name "gtk_widget_get_allocation")
+ (c-name "_gtk_widget_get_allocation")
+ (overrides "gtk_widget_get_allocation")
(return-type "GdkRectangle*")) ;; same as GtkAllocation
(define-method get_state
* libglade: git 'diff' 'HEAD'
diff --git a/gnome/gw/glade-support.c b/gnome/gw/glade-support.c
index b8f18ea..86d4507 100644
--- a/gnome/gw/glade-support.c
+++ b/gnome/gw/glade-support.c
@@ -26,8 +26,8 @@
#include "guile-gnome-gobject.h"
#define GRUNTIME_ERROR(format, func_name, args...) \
- scm_error_scm (scm_str2symbol ("gruntime-error"), scm_makfrom0str (func_name), \
- scm_simple_format (SCM_BOOL_F, scm_makfrom0str (format), \
+ scm_error_scm (scm_from_locale_symbol ("gruntime-error"), scm_from_locale_string (func_name), \
+ scm_simple_format (SCM_BOOL_F, scm_from_locale_string (format), \
scm_list_n (args, SCM_UNDEFINED)), \
SCM_EOL, SCM_EOL)
@@ -54,7 +54,7 @@ connect_one (const gchar *handler_name, GObject *object, const gchar *signal_nam
proc = GPOINTER_TO_SCM (user_data);
scm_call_4 (gtype_instance_signal_connect_data,
scm_c_gtype_instance_to_scm (object),
- scm_str2symbol (signal_name),
+ scm_from_locale_symbol (signal_name),
proc,
after ? SCM_BOOL_T : SCM_BOOL_F);
}
@@ -72,7 +72,7 @@ _wrap_glade_xml_signal_connect (GladeXML *xml, const char *handlername, SCM proc
SCM handle_read_error (char *handler_name, SCM tag, SCM throw_args)
{
GRUNTIME_ERROR ("Error while reading signal handler ~S: ~A: ~S",
- "glade-xml-signal-autoconnect", scm_makfrom0str (handler_name),
+ "glade-xml-signal-autoconnect", scm_from_locale_string (handler_name),
tag, throw_args);
}
@@ -92,8 +92,8 @@ connect_many (const gchar *handler_name, GObject *object, const gchar *signal_na
module);
if (SCM_FALSEP (scm_procedure_p (proc)))
GRUNTIME_ERROR ("Tried to set `~A' to handle signal `~A', but it's not a procedure",
- "glade-xml-signal-autoconnect", scm_makfrom0str (handler_name),
- scm_makfrom0str (signal_name));
+ "glade-xml-signal-autoconnect", scm_from_locale_string (handler_name),
+ scm_from_locale_string (signal_name));
connect_one (NULL, object, signal_name, NULL, NULL, after,
SCM_TO_GPOINTER (proc));
* libgnome: git 'diff' 'HEAD'
* libgnomecanvas: git 'diff' 'HEAD'
* libgnomeui: git 'diff' 'HEAD'
* pango: git 'diff' 'HEAD'
diff --git a/gnome/gw/pango-support.c b/gnome/gw/pango-support.c
index 421b68e..e528ec6 100644
--- a/gnome/gw/pango-support.c
+++ b/gnome/gw/pango-support.c
@@ -31,10 +31,10 @@ scm_pango_rectangle_to_scm (PangoRectangle *rect)
{
SCM ret = scm_c_make_vector (4, SCM_BOOL_F);
- scm_c_vector_set_x (ret, 0, scm_int2num (rect->x));
- scm_c_vector_set_x (ret, 1, scm_int2num (rect->y));
- scm_c_vector_set_x (ret, 2, scm_int2num (rect->width));
- scm_c_vector_set_x (ret, 3, scm_int2num (rect->height));
+ scm_c_vector_set_x (ret, 0, scm_from_int (rect->x));
+ scm_c_vector_set_x (ret, 1, scm_from_int (rect->y));
+ scm_c_vector_set_x (ret, 2, scm_from_int (rect->width));
+ scm_c_vector_set_x (ret, 3, scm_from_int (rect->height));
return ret;
}
@@ -44,7 +44,7 @@ scm_scm_to_pango_rectangle (SCM scm, PangoRectangle* rect)
#define FUNC_NAME "%scm->pango-rectangle"
{
#define GET_VINT(v,i) \
- scm_num2int (scm_c_vector_ref (v, i), 0, FUNC_NAME)
+ scm_to_int (scm_c_vector_ref (v, i))
rect->x = GET_VINT (scm, 0);
rect->y = GET_VINT (scm, 1);
* .: git 'diff' 'HEAD'