1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
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)))
|
