[Guile-GTK] Tiny patches

[email protected] (Ludovic Courtès)
Newsgroups gmane.lisp.guile.gtk
Message-ID <[email protected]>
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.

_______________________________________________
guile-gtk-general mailing list
[email protected]
http://lists.gnu.org/mailman/listinfo/guile-gtk-general
0002-Use-const-qualified-string-arguments-when-appropri.patch (text/x-diff, 10.6 KB)
From e066396b3a3485b781e5a5870c31cb7c0ecad4a5 Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <[email protected]>
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
0003-Correctly-honor-conditionalize-options.patch (text/x-diff, 3.1 KB)
From 7012b5156a58761bf2ee8149662296f311eed75a Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <[email protected]>
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
0004-Conditionalize-gtk_link_button_set_uri_hook.patch (text/x-diff, 2.2 KB)
From b1c04023153041779252dc6613aa4566f60cfd2a Mon Sep 17 00:00:00 2001
From: =?utf-8?q?Ludovic=20Court=C3=A8s?= <[email protected]>
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
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.