[rep-gtk] sync with Jürgen Hötzels branch

[Christopher Bratusek <chrisb src gnome org>]

commit 2110b7dcb51a46f6d742d548e8ef6ed9adc9ecd5
Author: chrisb <zanghar freenet de>
Date:   Fri Aug 28 21:08:31 2009 +0200

    sync with Jürgen Hötzels branch

 ChangeLog               |    8 +++++++-
 README.gtk-defs         |    3 ++-
 build-gtk.jl            |   15 +++++++++++++++
 examples/gtk-builder.jl |   25 ++++++++++++-------------
 gtkbuilder.defs         |    5 ++---
 rep-gtk.c               |   14 ++++++++++++++
 rep-gtk.h               |    2 ++
 7 files changed, 54 insertions(+), 18 deletions(-)
---
diff --git a/ChangeLog b/ChangeLog
index 17f8d3c..8d85d48 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,6 +1,12 @@
+2009-08-28  Christopher Bratusek <zanghar freenet de>
+	* <tree>:
+	sync with Jürgen Hötzels branch
+	- GError support
+
 2009-08-26  Christopher Bratusek <zanghar freenet de>
-	* gtk.defs:
+	* <tree>:
 	sync with Jürgen Hötzels branch
+	- basic GtkBuilder support
 
 2009-08-22  Christopher Bratusek <zanghar freenet de>
 	* gtk.defs:
diff --git a/README.gtk-defs b/README.gtk-defs
index dd24080..d52f86b 100644
--- a/README.gtk-defs
+++ b/README.gtk-defs
@@ -60,7 +60,8 @@ and each OPTION may be one of:
   (protection *result*)			; gc protect for life of RETURN-VALUE
   (undeferred t)			; no scm interrupt protection?
   (rest-arg t)				; last arg is &rest
-
+  (gerror-arg t)				; last arg is GError arg
+  
 and each ARG-OPTION may be one of:
 
   (= "default expression")
diff --git a/build-gtk.jl b/build-gtk.jl
index 6a69b79..668f662 100644
--- a/build-gtk.jl
+++ b/build-gtk.jl
@@ -918,6 +918,8 @@
 		  (@ "  %s c_%s;\n" decl (gtk-arg-name arg))
 		(gtk-warning
 		 "Don't know how to declare type: %s" type)))) args)
+    (when (gtk-get-option 'gerror-arg options)
+      (@ "  GError* error = NULL;\n"))
     (unless (eq ret 'none)
       (let*
 	  ((typage (gtk-type-info ret))
@@ -1040,6 +1042,8 @@
 	      (@ "c_%s" (gtk-arg-name (car tem)))))
 	  (@ (if (cdr tem) ", " ""))
 	  (setq tem (cdr tem))))
+      (if (gtk-get-option 'gerror-arg options)
+	  (@ ", &error"))
       (@ "\);\n\n"))
 
     ;; output ret conversion
@@ -1076,6 +1080,11 @@
 	      (@ "  rep_POPGC;\n"
 		 (gtk-arg-name arg) (gtk-arg-name arg)))) args)
 
+    ;; gerror checking
+    (when (gtk-get-option 'gerror-arg options)
+      (@ "  if (error != NULL)\n" )
+      (@ "    sgtk_throw_gerror (\"%s\", error);\n" fname))
+    
     ;; output return statement
     (if (eq ret 'none)
 	(@ "  return Qnil;\n")
@@ -1203,6 +1212,12 @@
   (let
       ((out nil)
        (point 0))
+
+    ;; Some Classes (GtkUIManager) contain Upcase Tokens: UI
+    (while (string-match "[A-Z]([A-Z]+)[A-Z]" name)
+      (let ((upcase-token (substring name (match-start 1) (match-end 1))))
+	(setq name (string-replace upcase-token (string-downcase upcase-token) name))))
+
     (while (string-match "[A-Z]+" name point)
       (setq out (cons (substring name point (match-start)) out))
       (unless (zerop point)
diff --git a/examples/gtk-builder.jl b/examples/gtk-builder.jl
index 1d201bd..bd9f829 100644
--- a/examples/gtk-builder.jl
+++ b/examples/gtk-builder.jl
@@ -8,20 +8,19 @@
 	  gui.gtk-2.gtk)
 
   (define builder (gtk-builder-new))
-  (gtk-builder-add-from-file builder "gtk-builder-test.glade")
-  (define window (gtk-builder-get-object builder "window"))
-  (gtk-widget-show-all window)
-
-  (g-signal-connect (gtk-builder-get-object builder "button") "pressed" 
-		    (lambda ()
-		      (message "Button pressed")))
-
-  (gtk-builder-connect-signals builder)
-
-  (setq interrupt-mode 'exit)
-  (recursive-edit))
-
 
+  (condition-case data (progn 
+			 (gtk-builder-add-from-file builder "gtk-builder-test.glade")
+			 (define window (gtk-builder-get-object builder "window"))
+			 (gtk-widget-show-all window)
+			 (g-signal-connect (gtk-builder-get-object builder "button") "pressed" 
+					   (lambda ()
+					     (message "Button pressed")))
+
+			 (gtk-builder-connect-signals builder)
+			 (setq interrupt-mode 'exit)
+			 (recursive-edit))
+    (glib-error (message (cadr data)))))
 
 ;; Local variables:
 ;; major-mode: lisp-mode
diff --git a/gtkbuilder.defs b/gtkbuilder.defs
index 971749e..ba06d22 100644
--- a/gtkbuilder.defs
+++ b/gtkbuilder.defs
@@ -9,9 +9,8 @@
 (define-func gtk_builder_add_from_file
   (int)
   ((GtkBuilder builder)
-   (string filename)
-   ;; XXX fix this
-   (GPointer gerror (= "0"))))
+   (string filename))
+  (gerror-arg t))
 
 (define-func gtk_builder_get_object 
   (GObject)
diff --git a/rep-gtk.c b/rep-gtk.c
index 8f53d7a..73ed346 100644
--- a/rep-gtk.c
+++ b/rep-gtk.c
@@ -2318,6 +2318,19 @@ sgtk_sigchld_callback (void)
 
 
 
+/* GError handling */
+DEFSYM(g_error, "glib-error");
+DEFSTRING(err_g_error, "Glib error");
+
+void
+sgtk_throw_gerror (const char *func_name, GError *gerr)
+{
+
+  /* FIXME: We should also handle error domain */
+  Fsignal (Qg_error, rep_list_1(rep_string_dup (gerr->message)));
+  g_error_free (gerr);
+}
+
 /* Initialization */
 
 static int standalone_p = 1;
@@ -2444,6 +2457,7 @@ sgtk_init_substrate (void)
   rep_INTERN (gtk_minor_version);
   rep_INTERN (gtk_micro_version);
   rep_INTERN (rep_gtk_version);
+  rep_INTERN(g_error); rep_ERROR(g_error);
   Fset (Qgtk_major_version, rep_MAKE_INT (GTK_MAJOR_VERSION));
   Fset (Qgtk_minor_version, rep_MAKE_INT (GTK_MINOR_VERSION));
   Fset (Qgtk_micro_version, rep_MAKE_INT (GTK_MICRO_VERSION));
diff --git a/rep-gtk.h b/rep-gtk.h
index d2b2c58..7d068ea 100644
--- a/rep-gtk.h
+++ b/rep-gtk.h
@@ -224,6 +224,8 @@ GParameter *sgtk_build_args (GObjectClass *objclass, int *n_argsp,
 repv sgtk_color_conversion (repv color);
 repv sgtk_font_conversion (repv color);
 
+void sgtk_throw_gerror (const char *func_name, GError *gerr);
+
 void sgtk_set_standalone (int flag);
 int sgtk_is_standalone (void);
 repv sgtk_standalone_p (void);