Description: update for newer gtk
Author: NIIBE Yutaka <gniibe@fsij.org>
Reviewed-By: NIIBE Yutaka <gniibe@fsij.org>
Last-Update: 2010-03-19

Index: gauche-gtk-0.4.1/src/h2stub.scm
===================================================================
--- gauche-gtk-0.4.1.orig/src/h2stub.scm	2004-06-24 20:49:19.000000000 +0900
+++ gauche-gtk-0.4.1/src/h2stub.scm	2010-03-17 17:19:41.000000000 +0900
@@ -44,7 +44,7 @@
                #`"pkg-config --variable=includedir gtk+-,(gtk-version)"
              (cut port->string-list <>))
            (call-with-input-process
-               #`"pkg-config --variable=includedir pango-,(pango-version)"
+               #`"pkg-config --variable=includedir pango"
              (cut port->string-list <>))
            '("/usr/include" "/usr/local/include"))
    string=?))
@@ -485,6 +485,9 @@
         (#/^\{/ () (loop (read-line) fields))
         (#/^\}/ () (make-struct name (reverse fields)))
         (test has-comment? (skip-comment line (cut loop <> fields) err-eof))
+        (#/^\s+(.*)\s+(\*)?GSEAL\s*\(([^\)]*)\)(.*)$/
+	   (#f something pointer contents rest)
+	   (loop (string-append " " something " " (if pointer pointer "") contents rest) fields))
         (#/^\s+([\w\*_]+)\s+([\w\*_]+)(\[([\w_]+)\])?\s*(:\s*\d+\s*)?\;/
            (#f type var #f array)
          (if array
@@ -529,6 +529,11 @@
              (enums '()))
     (rxmatch-case line
       (test eof-object? (err-eof))
+      (#/^\#if/ () (let skip-to-endif ((line (read-line)))
+		     (rxmatch-case line
+		       (test eof-object? (err-eof))
+		       (#/^\#endif\s*(.*)/ (#f rest) (loop rest enums))
+		       (else (skip-to-endif (read-line))))))
       (#/^\{/ () (loop (read-line) enums))
       (#/^\}\s*([\w_]+)/ (#f name) (make-enum name (reverse enums)))
       (#/^\s*$/ () (loop (read-line) enums))
@@ -727,7 +732,7 @@
               (values #f #f)
               (let ((first-slot-type (type-of (car (fields-of self)))))
                 (cond
-                 ((eq? (c-name-of first-slot-type) 'GObject)
+                 ((memq (c-name-of first-slot-type) '(GObject GInitiallyUnowned))
                   (values first-slot-type #t))
                  ((and-let* ((ptrname (string->symbol #`",(c-name-of first-slot-type)*"))
                              (ptrtype (find-type ptrname))
@@ -746,7 +751,7 @@
         (let loop ((super (superclass-of self))
                    (classes '()))
           (cond ((not super) (reverse classes))
-                ((eq? (c-name-of super) 'GObject)
+                ((memq (c-name-of super) '(GObject GInitiallyUnowned))
                  (reverse (cons "Scm_GObjectClass" classes)))
                 ((eq? (c-name-of super) 'GdkEvent*)
                  (reverse (cons "Scm_GdkEventClass" classes)))