[Guile-GTK] Tiny patches

[Ludovic Courtès]

Hi,

Attached are three small patches for Guile-GTK, each with an associated
comment.

I found it nice to have this minimal set of GTK bindings to port to
Maemo, especially for distributions that include relatively old versions
of GTK+.

Thanks,
Ludovic.

>From e066396b3a3485b781e5a5870c31cb7c0ecad4a5 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Fri, 9 Nov 2007 18:51:58 +0100
Subject: [Guile-GTK] Use `const'-qualified string arguments when appropriate.

* gtk-support.c (sgtk_gdk_gc_values_fill,
  gdk_string_to_compound_text_interp): Use `const'-qualified string
  arguments.

* gtk-compat.c (gdk_color_parse_interp): Likewise.

* gtk-support.c (gtk_editable_insert_text_scm): Likewise.

* guile-gtk.c (sgtk_try_missing_type, sgtk_maybe_find_type_info,
  sgtk_scm2enum, sgtk_scm2flags, sgtk_senum2scm, sgtk_type_from_name,
  sgtk_find_object_info, gtk_class_new, sgtk_signal_emit,
  sgtk_register_glue): Likewise.

* guile-gtk.h (sgtk_type_info)[name]: Use `const char *'.
  Update function prototypes.
---
 gdk-support.c |    6 +++---
 gtk-compat.c  |    2 +-
 gtk-support.c |    2 +-
 guile-gtk.c   |   24 ++++++++++++------------
 guile-gtk.h   |   26 +++++++++++++-------------
 5 files changed, 30 insertions(+), 30 deletions(-)

diff --git a/gdk-support.c b/gdk-support.c
index cbedeb8..ef08d2a 100644
--- a/gdk-support.c
+++ b/gdk-support.c
@@ -209,7 +209,7 @@ SCM_KEYWORD (kw_ts_y_origin,        "ts-y-origin");
 /* This is a separate function so it can be shared in the future by
    gtk-gc-get.  */
 GdkGCValuesMask
-sgtk_gdk_gc_values_fill (char *func_name, int argnum,
+sgtk_gdk_gc_values_fill (const char *func_name, int argnum,
                          GdkGCValues *values, SCM rest)
 {
   GdkGCValuesMask mask;
@@ -1835,8 +1835,8 @@ gdk_text_property_to_text_list_interp (GdkAtom encoding, 
gint format, SCM text)
 #undef FUNCNAME
 
 gint
-gdk_string_to_compound_text_interp (char *str, GdkAtom *encoding, gint *format,
-                                    SCM *textp)
+gdk_string_to_compound_text_interp (const char *str, GdkAtom *encoding,
+                                   gint *format, SCM *textp)
 {
   guchar *ctext;
   gint ret, length;
diff --git a/gtk-compat.c b/gtk-compat.c
index 29b0988..f880995 100644
--- a/gtk-compat.c
+++ b/gtk-compat.c
@@ -44,7 +44,7 @@ gtk_menu_popup_interp (GtkMenu *menu,
 }
 
 GdkColor*
-gdk_color_parse_interp (char *spec)
+gdk_color_parse_interp (const char *spec)
 {
   GdkColor color;
   return gdk_color_parse (spec, &color) ? gdk_color_copy (&color) : NULL;
diff --git a/gtk-support.c b/gtk-support.c
index 2d114fc..90c4e3e 100644
--- a/gtk-support.c
+++ b/gtk-support.c
@@ -167,7 +167,7 @@ gtk_style_base_gc (GtkStyle *style, GtkStateType state)
 
 int
 gtk_editable_insert_text_scm (GtkEditable *editable,
-                             gchar       *text,
+                             const gchar *text,
                              int          position)
 {
   gtk_editable_insert_text (editable, text, strlen (text), &position);
diff --git a/guile-gtk.c b/guile-gtk.c
index 78788f5..a8be81e 100644
--- a/guile-gtk.c
+++ b/guile-gtk.c
@@ -387,7 +387,7 @@ sgtk_register_type_infos_gtk (GtkTypeInfo **infos)
    entirely.  */
 
 static GtkType
-sgtk_try_missing_type (char *name)
+sgtk_try_missing_type (const char *name)
 {
   static sgtk_type_info missing[] = {
     {NULL, GTK_TYPE_NONE, NULL}
@@ -398,7 +398,7 @@ sgtk_try_missing_type (char *name)
     if (!strcmp (m->name, name))
       {
        GtkTypeInfo info = { NULL };
-       info.type_name = name;
+       info.type_name = (char *) name;
        return gtk_type_unique (m->type, &info);
       }
 
@@ -439,7 +439,7 @@ sgtk_maybe_find_type_info (GtkType type)
 {
   sgtk_type_info *info;
   type_infos *infos;
-  char *name;
+  const char *name;
   int i;
 
   for (i = 0; i < n_type_info_tab; i++)
@@ -1012,7 +1012,7 @@ sgtk_enum2scm (gint val, sgtk_enum_info *info)
 }
 
 gint
-sgtk_scm2enum (SCM obj, sgtk_enum_info *info, int pos, char *sname)
+sgtk_scm2enum (SCM obj, sgtk_enum_info *info, int pos, const char *sname)
 {
   int rval;
 
@@ -1072,7 +1072,7 @@ sgtk_flags2scm (gint val, sgtk_enum_info *info)
 }
 
 gint
-sgtk_scm2flags (SCM obj, sgtk_enum_info *info, int pos, char *sname)
+sgtk_scm2flags (SCM obj, sgtk_enum_info *info, int pos, const char *sname)
 {
   if (scm_is_pair (obj) || scm_is_null (obj))
     {
@@ -1163,7 +1163,7 @@ sgtk_valid_senum (SCM obj, sgtk_senum_info *info)
 }
 
 SCM
-sgtk_senum2scm (char *val, sgtk_senum_info *info)
+sgtk_senum2scm (const char *val, sgtk_senum_info *info)
 {
   int i;
   for (i = 0; i < info->n_literals; i++)
@@ -1454,7 +1454,7 @@ all_type_infos_find (const char *name)
    we search among the type names we have in all_type_infos and initialize
    the type with the init_func in our sgtk_type_info.  */
 GtkType
-sgtk_type_from_name (char *name)
+sgtk_type_from_name (const char *name)
 {
   GType type = g_type_from_name (name);
   if (type == GTK_TYPE_INVALID)
@@ -2676,7 +2676,7 @@ sgtk_gtk_target_entry_free (GtkTargetEntry* entry)
 /* The SCM_PROC for the exported functions is in gtk-support.c to have
    it be snarfed for sgtk_init_gtk_support. */
 
-sgtk_object_info *sgtk_find_object_info (char *name);
+sgtk_object_info *sgtk_find_object_info (const char *name);
 
 sgtk_object_info *
 sgtk_find_object_info_from_type (GtkType type)
@@ -2690,7 +2690,7 @@ sgtk_find_object_info_from_type (GtkType type)
 }
 
 sgtk_object_info *
-sgtk_find_object_info (char *name)
+sgtk_find_object_info (const char *name)
 {
   GtkType type, parent;
   sgtk_object_info *info;
@@ -2982,7 +2982,7 @@ sgtk_gtk_object_get (SCM scm_obj, SCM argsym)
 /* Creating new object classes */
 
 GtkType
-gtk_class_new (GtkType parent_type, gchar *name)
+gtk_class_new (GtkType parent_type, const gchar *name)
 {
   GTypeInfo *info;
   GTypeQuery parent_query;
@@ -3073,7 +3073,7 @@ gtk_signal_new_generic (const gchar     *name,
 }
 
 SCM
-sgtk_signal_emit (GObject *obj, char *name, SCM scm_params)
+sgtk_signal_emit (GObject *obj, const char *name, SCM scm_params)
 {
   static char func_name[] = "gtk-signal-emit";
   
@@ -3189,7 +3189,7 @@ sgtk_standalone_p ()
 }
 
 void
-sgtk_register_glue (char *name, void (*func)(void))
+sgtk_register_glue (const char *name, void (*func)(void))
 {
   scm_c_register_extension (NULL, name, (void (*)(void *))func, NULL);
 }
diff --git a/guile-gtk.h b/guile-gtk.h
index 89d0d79..d28a668 100644
--- a/guile-gtk.h
+++ b/guile-gtk.h
@@ -25,7 +25,7 @@
 typedef guint32 sgtk_timestamp;
 
 typedef struct _sgtk_type_info {
-  char *name;
+  const char *name;
   GtkType type;
   SCM (*conversion) (SCM);
   GtkType (*init_func) ();
@@ -114,7 +114,7 @@ SCM sgtk_make_cblk (void *p, size_t len);
 void sgtk_register_type_infos (sgtk_type_info **infos);
 void sgtk_register_type_infos_gtk (GtkTypeInfo **infos);
 sgtk_type_info *sgtk_get_type_info (guint type_seqno);
-GtkType sgtk_type_from_name (char *name);
+GtkType sgtk_type_from_name (const char *name);
 
 SCM sgtk_wrap_gtkobj (GObject *obj);
 SCM sgtk_wrap_gtkobj_nocopy (GObject *obj);
@@ -127,14 +127,14 @@ int sgtk_enum_flags_bin_search (SCM key, sgtk_enum_info 
*info, int *rval);
 
 int sgtk_valid_enum (SCM obj, sgtk_enum_info*);
 SCM sgtk_enum2scm (gint val, sgtk_enum_info*);
-gint sgtk_scm2enum (SCM obj, sgtk_enum_info*, int pos, char *sname);
+gint sgtk_scm2enum (SCM obj, sgtk_enum_info*, int pos, const char *sname);
 
 int sgtk_valid_flags (SCM obj, sgtk_enum_info*);
 SCM sgtk_flags2scm (gint val, sgtk_enum_info*);
-gint sgtk_scm2flags (SCM obj, sgtk_enum_info*, int pos, char *sname);
+gint sgtk_scm2flags (SCM obj, sgtk_enum_info*, int pos, const char *sname);
 
 int sgtk_valid_senum (SCM obj, sgtk_senum_info*);
-SCM sgtk_senum2scm (char *val, sgtk_senum_info*);
+SCM sgtk_senum2scm (const char *val, sgtk_senum_info*);
 char *sgtk_scm2senum (SCM obj, sgtk_senum_info*);
 
 SCM sgtk_boxed2scm (gpointer ptr, sgtk_boxed_info*, int copyp);
@@ -232,7 +232,7 @@ void sgtk_scm2ret (GtkArg *a, SCM obj);
 void sgtk_throw_gerror (const char *func_name, GError *gerr);
 
 sgtk_object_info *sgtk_find_object_info_from_type (GtkType type);
-sgtk_object_info *sgtk_find_object_info (char *name);
+sgtk_object_info *sgtk_find_object_info (const char *name);
 
 SCM sgtk_color_conversion (SCM color);
 SCM sgtk_font_conversion (SCM color);
@@ -241,7 +241,7 @@ void sgtk_set_standalone (int flag);
 int sgtk_is_standalone ();
 SCM sgtk_standalone_p ();
 
-void sgtk_register_glue (char *name, void (*func)(void));
+void sgtk_register_glue (const char *name, void (*func)(void));
 #define SGTK_REGISTER_GLUE(func) sgtk_register_glue (#func, func)
 
 void sgtk_init_gdk_support (void);
@@ -339,7 +339,7 @@ char *gdk_wcstombs_interp (GdkWChar src[], int count);
 
 SCM gdk_mbstowcs_interp (const char *src);
 
-GdkGCValuesMask sgtk_gdk_gc_values_fill (char *func_name, int argnum,
+GdkGCValuesMask sgtk_gdk_gc_values_fill (const char *func_name, int argnum,
                                          GdkGCValues *values, SCM rest);
 GdkGC *gdk_gc_new_with_values_interp (GdkWindow *window, SCM rest);
 SCM gdk_gc_get_values_interp (GdkGC *gc);
@@ -347,7 +347,7 @@ SCM gdk_gc_get_values_interp (GdkGC *gc);
 guint32 gdk_get_leader_window_id ();
 
 int gtk_editable_insert_text_scm (GtkEditable *editable,
-                                  gchar *text, int position);
+                                  const gchar *text, int position);
 
 void gdk_draw_text_interp (GdkDrawable *drawable, GdkFont *font, GdkGC *gc,
                           gint x, gint y, SCM text);
@@ -376,14 +376,14 @@ void gtk_menu_popup_interp (GtkMenu *menu,
                            guint32 activate_time);
 
 GdkColor *gdk_color_new (void);
-GdkColor *gdk_color_parse_interp (char *spec);
+GdkColor *gdk_color_parse_interp (const char *spec);
 GdkColor *gtk_style_get_white_interp (GtkStyle *style);
 
 void gtk_list_append_item (GtkList *list, GtkListItem *item);
 void gtk_list_prepend_item (GtkList *list, GtkListItem *item);
 
 gboolean gtk_type_get_info (GtkType type, GtkTypeInfo *info);
-GtkType gtk_class_new (GtkType parent_type, gchar *name);
+GtkType gtk_class_new (GtkType parent_type, const gchar *name);
 guint
 gtk_signal_new_generic (const gchar     *name,
                        GtkSignalRunType signal_flags,
@@ -391,7 +391,7 @@ gtk_signal_new_generic (const gchar     *name,
                        GtkType          return_type,
                        guint            nparams,
                        GtkType         *params);
-SCM sgtk_signal_emit (GObject *obj, char *name, SCM scm_args);
+SCM sgtk_signal_emit (GObject *obj, const char *name, SCM scm_args);
 void gtk_signal_set_class_function_full (GtkType            type,
                                         const gchar       *signal,
                                         GtkSignalFunc      func,
@@ -505,7 +505,7 @@ void gdk_property_change_interp (GdkWindow *window,
 
 SCM gdk_text_property_to_text_list_interp (GdkAtom encoding, gint format,
                                           SCM text);
-gint gdk_string_to_compound_text_interp (char *str, GdkAtom *encoding,
+gint gdk_string_to_compound_text_interp (const char *str, GdkAtom *encoding,
                                          gint *format, SCM *textp);
 SCM gdk_property_get_interp (GdkWindow *window, GdkAtom property, GdkAtom type,
                             gulong offset, gulong length, int pdelete,
-- 
1.5.3.4

>From 7012b5156a58761bf2ee8149662296f311eed75a Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Sat, 10 Nov 2007 00:50:07 +0100
Subject: [Guile-GTK] Correctly honor `conditionalize' options.

* build-guile-gtk-2.0 (emits-funcs)[emit-func]: Surround
  `scm_c_define_gsubr ()' with `conditionalize-start' and
  `conditionalize-end'.
  [emit-object-predicate]: New OPTS parameter.  Inherit options from the
  object so that `conditionalize' in particular is honored.  Update
  callers.
---
 build-guile-gtk-2.0 |   22 ++++++++++++----------
 1 files changed, 12 insertions(+), 10 deletions(-)

diff --git a/build-guile-gtk-2.0 b/build-guile-gtk-2.0
index 9e94754..d516b76 100644
--- a/build-guile-gtk-2.0
+++ b/build-guile-gtk-2.0
@@ -957,9 +957,11 @@ exec guile -s $0 $*
       (@ "static char s_~a[] = \"~a\";~%~%" 
         fullname (if scm-name scm-name (scmname fname)))
       (add-init
-       (@@ "scm_c_define_gsubr (s_~a, ~a, ~a, ~a, sgtk_~a);"
+       (@@ "~ascm_c_define_gsubr (s_~a, ~a, ~a, ~a, sgtk_~a);~%~a"
+           (with-output-to-string (lambda () (conditionalize-start opts)))
           fullname (if n-hack 9 n-preal) n-opt (if (or n-hack (= n-rest 1)) 1 
0)
-          fullname))
+          fullname
+           (with-output-to-string (lambda () (conditionalize-end opts)))))
       (@ "SCM~%")
       (@ "sgtk_~a (~a)~%" 
         fullname
@@ -1117,13 +1119,13 @@ exec guile -s $0 $*
                      name (syllables->string cparms ", "))))
       (set! cur-protection #f)))
 
-  (define (emit-object-predicate sym name)
+  (define (emit-object-predicate sym name opts)
     (let ((type (lookup-type sym)))
       (if (not (imported-type? sym))
-         (emit-func 'bool (append name '("p")) '((SCM obj)) 
-                    (string-append* (scmname name) "?") '()
-                    (lambda (cret cparms)
-                      (@ "~a = ~a;" cret (type-isa type (car cparms))))))))
+          (emit-func 'bool (append name '("p")) '((SCM obj)) 
+                     (string-append* (scmname name) "?") opts
+                     (lambda (cret cparms)
+                       (@ "~a = ~a;" cret (type-isa type (car cparms))))))))
 
   (define (emit-field-accessors typesym typename fields)
     (define (emit-accessor field)
@@ -1622,11 +1624,11 @@ exec guile -s $0 $*
                                 (emit-field-accessors name canonical fields))
                               (emit-converter-if-defined name canonical
                                                          options #f)
-                              (emit-object-predicate name canonical))
+                              (emit-object-predicate name canonical options))
                              ((define-boxed-union)
                               (register-boxed-union-converter name
                                                               (caddr form))
-                              (emit-object-predicate name canonical))
+                              (emit-object-predicate name canonical options))
                              ((define-ptype)
                               (register-ptype-converter name canonical
                                                         options)
@@ -1638,7 +1640,7 @@ exec guile -s $0 $*
                              ((define-object)
                               (register-object-type name canonical options)
                               (conditionalize-start options)
-                              (emit-object-predicate name canonical)
+                              (emit-object-predicate name canonical options)
                               (let ((fields (get-opt options
                                                      'fields '())))
                                 (emit-field-accessors name canonical fields))
-- 
1.5.3.4

>From b1c04023153041779252dc6613aa4566f60cfd2a Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <address@hidden>
Date: Sat, 10 Nov 2007 01:01:26 +0100
Subject: [Guile-GTK] Conditionalize `gtk_link_button_set_uri_hook ()'.

* configure.ac: Check for `gtk_link_button_set_uri_hook ()'.

* gtk-2.0.defs (gtk_link_button_set_uri_hook_interp): Conditionalize.

* gtk-support.c (gtk_link_button_set_uri_hook_interp): Enclose in
  `#ifdef HAVE_GTK_LINK_BUTTON_SET_URI_HOOK'.
---
 configure.ac  |    3 ++-
 gtk-2.0.defs  |    3 ++-
 gtk-support.c |    4 ++++
 3 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/configure.ac b/configure.ac
index bb6ffa9..8771ccc 100644
--- a/configure.ac
+++ b/configure.ac
@@ -145,9 +145,10 @@ CPPFLAGS="$GUILE_CFLAGS $CPPFLAGS"
 # Reasons for testing:
 #     g_object_ref_sink - not in glib 2.6
 #     gtk_link_button_new - new in gtk 2.10
+#     gtk_link_button_set_uri_hook - new in gtk 2.10
 #     mallinfo - not available on ancient systems
 #
-AC_CHECK_FUNCS(g_object_ref_sink gtk_link_button_new mallinfo 
scm_c_issue_deprecation_warning)
+AC_CHECK_FUNCS(g_object_ref_sink gtk_link_button_new 
gtk_link_button_set_uri_hook mallinfo scm_c_issue_deprecation_warning)
 
 AC_CHECK_HEADERS(malloc.h libguile/deprecation.h)
 
diff --git a/gtk-2.0.defs b/gtk-2.0.defs
index 3531cfd..332c810 100644
--- a/gtk-2.0.defs
+++ b/gtk-2.0.defs
@@ -5305,7 +5305,8 @@
 
 (define-func gtk_link_button_set_uri_hook_interp
   none
-  ((SCM func)))
+  ((SCM func))
+  (conditionalize "HAVE_GTK_LINK_BUTTON_SET_URI_HOOK"))
 
 ;; Options
 
diff --git a/gtk-support.c b/gtk-support.c
index 90c4e3e..c95e15f 100644
--- a/gtk-support.c
+++ b/gtk-support.c
@@ -298,6 +298,8 @@ gtk_about_dialog_set_url_hook_interp (SCM func)
        (GDestroyNotify) scm_gc_unprotect_object);
 }
 
+#ifdef HAVE_GTK_LINK_BUTTON_SET_URI_HOOK
+
 /* GtkLinkButtonUriFunc and GtkAboutDialogActivateLinkFunc are the same
    except for a pointer type, so can use
    sgtk_about_dialog_activate_link_marshal here.  */
@@ -313,6 +315,8 @@ gtk_link_button_set_uri_hook_interp (SCM func)
        (GDestroyNotify) scm_gc_unprotect_object);
 }
 
+#endif /* HAVE_GTK_LINK_BUTTON_SET_URI_HOOK */
+
 
 
 /* These SCM_PROCs are here to have them initialized in
-- 
1.5.3.4