* GError implementation status
@ 2003-08-04 13:55 Andreas Rottmann
0 siblings, 0 replies; only message in thread
From: Andreas Rottmann @ 2003-08-04 13:55 UTC (permalink / raw)
To: guile-gtk
[-- Attachment #1: Type: text/plain, Size: 721 bytes --]
Hi!
I've actually managed to implement GError as exception! However, this
required some extensions/changes in g-wrap. I've not yet done real
testing, but I thought I'll post my code for review. Attached is a
patch against guile-gobject (as in CVS) and against g-wrap 1.3.4.
You now can do the following:
,----
| guile> (use-modules (gnome glib))
| guile> (g-io-channel-new-file "/noexist" "r")
|
| Backtrace:
| In current input:
| 2: 0* [g-io-channel-new-file "/noexist" "r"]
|
| <unnamed port>:2:1: In procedure g-io-channel-new-file in expression (g-io-channel-new-file "/noexist" "r"):
| <unnamed port>:2:1: unhandled-exception: g-error 59 4 "No such file or directory"
| ABORT: (misc-error)
| guile>
`----
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: guile-gobject-CVS-mods.patch --]
[-- Type: text/x-patch, Size: 29810 bytes --]
? compile
? depcomp
? guile-gobject-uninstalled.pc
? guile-gobject.pc
? gnome/gobject/guile-gnome-gw-glib.c
? gnome/gobject/guile-gnome-gw-glib.h
? gnome/gobject/guile-gnome-gw-glib.html
? gnome/gobject/guile-gnome-gw-glib.log
? gnome/gobject/guile-gnome-gw-gobject.c
? gnome/gobject/guile-gnome-gw-gobject.h
? gnome/gobject/guile-gnome-gw-gobject.html
? gnome/gobject/guile-gnome-gw-standard.c
? gnome/gobject/guile-gnome-gw-standard.h
? gnome/gobject/guile-gnome-gw-standard.html
? gnome/gobject/gw-glib.scm
? gnome/gobject/gw-gobject.scm
? gnome/gobject/gw-standard.scm
? gnome/gtk/guile-gnome-gw-atk.c
? gnome/gtk/guile-gnome-gw-atk.h
? gnome/gtk/guile-gnome-gw-atk.html
? gnome/gtk/guile-gnome-gw-atk.log
? gnome/gtk/guile-gnome-gw-gdk.c
? gnome/gtk/guile-gnome-gw-gdk.h
? gnome/gtk/guile-gnome-gw-gdk.html
? gnome/gtk/guile-gnome-gw-gdk.log
? gnome/gtk/guile-gnome-gw-glib.log
? gnome/gtk/guile-gnome-gw-pango.c
? gnome/gtk/guile-gnome-gw-pango.h
? gnome/gtk/guile-gnome-gw-pango.html
? gnome/gtk/guile-gnome-gw-pango.log
? gnome/gtk/gw-atk.scm
? gnome/gtk/gw-gdk.scm
? gnome/gtk/gw-pango.scm
Index: ChangeLog
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/ChangeLog,v
retrieving revision 1.2
diff -u -p -u -r1.2 ChangeLog
--- ChangeLog 25 Jun 2003 12:41:49 -0000 1.2
+++ ChangeLog 4 Aug 2003 12:01:18 -0000
@@ -1,3 +1,8 @@
+2003-08-02 Andreas Rottmann <rottmann@users.sourceforge.net>
+
+ * h2def.py: Added --enums-without-gtype option, which will emit
+ the enum and flags defs without gtype-id.
+
2003-05-30 Andy Wingo <wingo@pobox.com>
* gw-standard-spec.scm (<gw:long-long>, <gw:unsigned-long-long>):
Index: h2def.py
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/h2def.py,v
retrieving revision 1.1.1.1
diff -u -p -u -r1.1.1.1 h2def.py
--- h2def.py 25 Jun 2003 12:30:28 -0000 1.1.1.1
+++ h2def.py 4 Aug 2003 12:01:19 -0000
@@ -186,7 +186,7 @@ def find_enum_defs(buf, enums=[]):
pos = m.end()
-def write_enum_defs(enums, output=None):
+def write_enum_defs(enums, output=None, without_gtype=0):
if type(output)==types.StringType:
fp=open(output,'w')
elif type(output)==types.FileType:
@@ -210,7 +210,8 @@ def write_enum_defs(enums, output=None):
if module:
fp.write(' (in-module "' + module + '")\n')
fp.write(' (c-name "' + cname + '")\n')
- fp.write(' (gtype-id "' + typecode(cname) + '")\n')
+ if not without_gtype:
+ fp.write(' (gtype-id "' + typecode(cname) + '")\n')
prefix = entries[0]
for ent in entries:
# shorten prefix til we get a match ...
@@ -401,9 +402,11 @@ if __name__ == '__main__':
onlyenums = 0
onlyobjdefs = 0
-
+ enums_without_gtype = 0
+
opts, args = getopt.getopt(sys.argv[1:], 'v',
- ['onlyenums', 'onlyobjdefs'])
+ ['onlyenums', 'onlyobjdefs',
+ 'enums-without-gtype'])
for o, v in opts:
if o == '-v':
verbose = 1
@@ -411,7 +414,9 @@ if __name__ == '__main__':
onlyenums = 1
if o == '--onlyobjdefs':
onlyobjdefs = 1
-
+ if o == '--enums-without-gtype':
+ enums_without_gtype = 1
+
if not args[0:1]:
print 'Must specify at least one input file name'
sys.exit(-1)
@@ -425,12 +430,12 @@ if __name__ == '__main__':
find_enum_defs(buf, enums)
objdefs = sort_obj_defs(objdefs)
if onlyenums:
- write_enum_defs(enums,None)
+ write_enum_defs(enums,None, without_gtype = enums_without_gtype)
elif onlyobjdefs:
write_obj_defs(objdefs,None)
else:
write_obj_defs(objdefs,None)
- write_enum_defs(enums,None)
+ write_enum_defs(enums,None, without_gtype = enums_without_gtype)
for filename in args:
write_def(filename,None)
Index: gnome/defs/ChangeLog
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/gnome/defs/ChangeLog,v
retrieving revision 1.2
diff -u -p -u -r1.2 ChangeLog
--- gnome/defs/ChangeLog 25 Jun 2003 12:41:50 -0000 1.2
+++ gnome/defs/ChangeLog 4 Aug 2003 12:01:19 -0000
@@ -1,3 +1,15 @@
+2003-08-02 Andreas Rottmann <rottmann@users.sourceforge.net>
+
+ * glib-override.defs: Removed some ignore-globs (*_ref, *_unref
+ and *_free), since g-wrap has no automatic reference-counting
+ or disposal of objects.
+ Ignore the GError-related functions, since the GError type is
+ exposed only via exceptions to the scheme level.
+
+2003-08-02 Andreas Rottmann <rottmann@users.sourceforge.net>
+
+ * glib.defs: Added defs for giochannel.h and gfilutils.h.
+
2003-05-25 Andy Wingo <wingo@pobox.com>
* gtk-overrides.defs: Ignore gtk_container_foreach -- to use this,
Index: gnome/defs/glib-overrides.defs
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/gnome/defs/glib-overrides.defs,v
retrieving revision 1.2
diff -u -p -u -r1.2 glib-overrides.defs
--- gnome/defs/glib-overrides.defs 3 Jul 2003 15:16:02 -0000 1.2
+++ gnome/defs/glib-overrides.defs 4 Aug 2003 12:01:19 -0000
@@ -8,10 +8,7 @@
(parameters '("GMainLoop*" "loop")))
(ignore-glob "_*"
- "*_ref"
- "*_unref"
"*_copy"
- "*_free"
"*_newv"
"*_valist"
"*_setv"
@@ -22,9 +19,10 @@
"g_timeout_remove*"
"g_idle_add*"
"g_idle_remove*"
+ "g_error_*"
"*win32*")
(ignore "g_main_context_wait"
- "g_error_new"
- "g_set_error")
+ "g_set_error"
+ "g_clear_error")
Index: gnome/defs/glib.defs
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/gnome/defs/glib.defs,v
retrieving revision 1.2
diff -u -p -u -r1.2 glib.defs
--- gnome/defs/glib.defs 1 Jul 2003 16:10:25 -0000 1.2
+++ gnome/defs/glib.defs 4 Aug 2003 12:01:19 -0000
@@ -560,4 +560,607 @@
)
)
+;; gfileutils.h [rotty]
+
+;; Enumerations and flags ...
+
+(define-enum FileError
+ (in-module "G")
+ (c-name "GFileError")
+ (values
+ '("exist" "G_FILE_ERROR_EXIST")
+ '("isdir" "G_FILE_ERROR_ISDIR")
+ '("acces" "G_FILE_ERROR_ACCES")
+ '("nametoolong" "G_FILE_ERROR_NAMETOOLONG")
+ '("noent" "G_FILE_ERROR_NOENT")
+ '("notdir" "G_FILE_ERROR_NOTDIR")
+ '("nxio" "G_FILE_ERROR_NXIO")
+ '("nodev" "G_FILE_ERROR_NODEV")
+ '("rofs" "G_FILE_ERROR_ROFS")
+ '("txtbsy" "G_FILE_ERROR_TXTBSY")
+ '("fault" "G_FILE_ERROR_FAULT")
+ '("loop" "G_FILE_ERROR_LOOP")
+ '("nospc" "G_FILE_ERROR_NOSPC")
+ '("nomem" "G_FILE_ERROR_NOMEM")
+ '("mfile" "G_FILE_ERROR_MFILE")
+ '("nfile" "G_FILE_ERROR_NFILE")
+ '("badf" "G_FILE_ERROR_BADF")
+ '("inval" "G_FILE_ERROR_INVAL")
+ '("pipe" "G_FILE_ERROR_PIPE")
+ '("again" "G_FILE_ERROR_AGAIN")
+ '("intr" "G_FILE_ERROR_INTR")
+ '("io" "G_FILE_ERROR_IO")
+ '("perm" "G_FILE_ERROR_PERM")
+ '("failed" "G_FILE_ERROR_FAILED")
+ )
+)
+
+(define-flags FileTest
+ (in-module "G")
+ (c-name "GFileTest")
+ (values
+ '("is-regular" "G_FILE_TEST_IS_REGULAR")
+ '("is-symlink" "G_FILE_TEST_IS_SYMLINK")
+ '("is-dir" "G_FILE_TEST_IS_DIR")
+ '("is-executable" "G_FILE_TEST_IS_EXECUTABLE")
+ '("exists" "G_FILE_TEST_EXISTS")
+ )
+)
+
+
+;; From /usr/include/glib-2.0/glib/gfileutils.h
+
+; This one wasn't found by h2def.py
+(define-function g_file_error_quark
+ (c-name "g_file_error_quark")
+ (return-type "GQuark")
+)
+
+(define-function g_file_error_from_errno
+ (c-name "g_file_error_from_errno")
+ (return-type "GFileError")
+ (parameters
+ '("gint" "err_no")
+ )
+)
+
+(define-function g_file_test
+ (c-name "g_file_test")
+ (return-type "gboolean")
+ (parameters
+ '("const-gchar*" "filename")
+ '("GFileTest" "test")
+ )
+)
+
+(define-function g_file_get_contents
+ (c-name "g_file_get_contents")
+ (return-type "gboolean")
+ (parameters
+ '("const-gchar*" "filename")
+ '("gchar**" "contents")
+ '("gsize*" "length")
+ '("GError**" "error")
+ )
+)
+
+(define-function g_mkstemp
+ (c-name "g_mkstemp")
+ (return-type "int")
+ (parameters
+ '("char*" "tmpl")
+ )
+)
+
+(define-function g_file_open_tmp
+ (c-name "g_file_open_tmp")
+ (return-type "int")
+ (parameters
+ '("const-char*" "tmpl")
+ '("char**" "name_used")
+ '("GError**" "error")
+ )
+)
+
+(define-function g_build_path
+ (c-name "g_build_path")
+ (return-type "gchar*")
+ (parameters
+ '("const-gchar*" "separator")
+ '("const-gchar*" "first_element")
+ )
+ (varargs #t)
+)
+
+(define-function g_build_filename
+ (c-name "g_build_filename")
+ (return-type "gchar*")
+ (parameters
+ '("const-gchar*" "first_element")
+ )
+ (varargs #t)
+)
+
+
+;; giochannel.h [rotty]
+
+;; Enumerations and flags ...
+
+(define-enum IOError
+ (in-module "G")
+ (c-name "GIOError")
+ (values
+ '("none" "G_IO_ERROR_NONE")
+ '("again" "G_IO_ERROR_AGAIN")
+ '("inval" "G_IO_ERROR_INVAL")
+ '("unknown" "G_IO_ERROR_UNKNOWN")
+ )
+)
+
+(define-enum IOChannelError
+ (in-module "G")
+ (c-name "GIOChannelError")
+ (values
+ '("fbig" "G_IO_CHANNEL_ERROR_FBIG")
+ '("inval" "G_IO_CHANNEL_ERROR_INVAL")
+ '("io" "G_IO_CHANNEL_ERROR_IO")
+ '("isdir" "G_IO_CHANNEL_ERROR_ISDIR")
+ '("nospc" "G_IO_CHANNEL_ERROR_NOSPC")
+ '("nxio" "G_IO_CHANNEL_ERROR_NXIO")
+ '("overflow" "G_IO_CHANNEL_ERROR_OVERFLOW")
+ '("pipe" "G_IO_CHANNEL_ERROR_PIPE")
+ '("failed" "G_IO_CHANNEL_ERROR_FAILED")
+ )
+)
+
+(define-enum IOStatus
+ (in-module "G")
+ (c-name "GIOStatus")
+ (values
+ '("error" "G_IO_STATUS_ERROR")
+ '("normal" "G_IO_STATUS_NORMAL")
+ '("eof" "G_IO_STATUS_EOF")
+ '("again" "G_IO_STATUS_AGAIN")
+ )
+)
+
+(define-enum SeekType
+ (in-module "G")
+ (c-name "GSeekType")
+ (values
+ '("cur" "G_SEEK_CUR")
+ '("set" "G_SEEK_SET")
+ '("end" "G_SEEK_END")
+ )
+)
+
+(define-enum IOCondition
+ (in-module "G")
+ (c-name "GIOCondition")
+ (values
+ '("in" "G_IO_IN")
+ '("out" "G_IO_OUT")
+ '("pri" "G_IO_PRI")
+ '("err" "G_IO_ERR")
+ '("hup" "G_IO_HUP")
+ '("nval" "G_IO_NVAL")
+ )
+)
+
+(define-flags IOFlags
+ (in-module "G")
+ (c-name "GIOFlags")
+ (values
+ '("append" "G_IO_FLAG_APPEND")
+ '("nonblock" "G_IO_FLAG_NONBLOCK")
+ '("is-readable" "G_IO_FLAG_IS_READABLE")
+ '("is-writeable" "G_IO_FLAG_IS_WRITEABLE")
+ '("is-seekable" "G_IO_FLAG_IS_SEEKABLE")
+ '("mask" "G_IO_FLAG_MASK")
+ '("get-mask" "G_IO_FLAG_GET_MASK")
+ '("set-mask" "G_IO_FLAG_SET_MASK")
+ )
+)
+
+
+;; From /usr/include/glib-2.0/glib/giochannel.h
+
+(define-method init
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_init")
+ (return-type "none")
+)
+
+(define-method ref
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_ref")
+ (return-type "none")
+)
+
+(define-method unref
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_unref")
+ (return-type "none")
+)
+
+(define-method read
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_read")
+ (return-type "GIOError")
+ (parameters
+ '("gchar*" "buf")
+ '("gsize" "count")
+ '("gsize*" "bytes_read")
+ )
+)
+
+(define-method write
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_write")
+ (return-type "GIOError")
+ (parameters
+ '("const-gchar*" "buf")
+ '("gsize" "count")
+ '("gsize*" "bytes_written")
+ )
+)
+
+(define-method seek
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_seek")
+ (return-type "GIOError")
+ (parameters
+ '("gint64" "offset")
+ '("GSeekType" "type")
+ )
+)
+
+(define-method close
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_close")
+ (return-type "none")
+)
+
+(define-method shutdown
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_shutdown")
+ (return-type "GIOStatus")
+ (parameters
+ '("gboolean" "flush")
+ '("GError**" "err")
+ )
+)
+
+(define-function g_io_add_watch_full
+ (c-name "g_io_add_watch_full")
+ (return-type "guint")
+ (parameters
+ '("GIOChannel*" "channel")
+ '("gint" "priority")
+ '("GIOCondition" "condition")
+ '("GIOFunc" "func")
+ '("gpointer" "user_data")
+ '("GDestroyNotify" "notify")
+ )
+)
+
+(define-function g_io_create_watch
+ (c-name "g_io_create_watch")
+ (return-type "GSource*")
+ (parameters
+ '("GIOChannel*" "channel")
+ '("GIOCondition" "condition")
+ )
+)
+
+(define-function g_io_add_watch
+ (c-name "g_io_add_watch")
+ (return-type "guint")
+ (parameters
+ '("GIOChannel*" "channel")
+ '("GIOCondition" "condition")
+ '("GIOFunc" "func")
+ '("gpointer" "user_data")
+ )
+)
+
+(define-method set_buffer_size
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_set_buffer_size")
+ (return-type "none")
+ (parameters
+ '("gsize" "size")
+ )
+)
+
+(define-method get_buffer_size
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_get_buffer_size")
+ (return-type "gsize")
+)
+
+(define-method get_buffer_condition
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_get_buffer_condition")
+ (return-type "GIOCondition")
+)
+
+(define-method set_flags
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_set_flags")
+ (return-type "GIOStatus")
+ (parameters
+ '("GIOFlags" "flags")
+ '("GError**" "error")
+ )
+)
+
+(define-method get_flags
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_get_flags")
+ (return-type "GIOFlags")
+)
+
+(define-method set_line_term
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_set_line_term")
+ (return-type "none")
+ (parameters
+ '("const-gchar*" "line_term")
+ '("gint" "length")
+ )
+)
+
+(define-method get_line_term
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_get_line_term")
+ (return-type "const-gchar*")
+ (parameters
+ '("gint*" "length")
+ )
+)
+
+(define-method set_buffered
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_set_buffered")
+ (return-type "none")
+ (parameters
+ '("gboolean" "buffered")
+ )
+)
+
+(define-method get_buffered
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_get_buffered")
+ (return-type "gboolean")
+)
+
+(define-method set_encoding
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_set_encoding")
+ (return-type "GIOStatus")
+ (parameters
+ '("const-gchar*" "encoding")
+ '("GError**" "error")
+ )
+)
+
+(define-method get_encoding
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_get_encoding")
+ (return-type "const-gchar*")
+)
+
+(define-method set_close_on_unref
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_set_close_on_unref")
+ (return-type "none")
+ (parameters
+ '("gboolean" "do_close")
+ )
+)
+
+(define-method get_close_on_unref
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_get_close_on_unref")
+ (return-type "gboolean")
+)
+
+(define-method flush
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_flush")
+ (return-type "GIOStatus")
+ (parameters
+ '("GError**" "error")
+ )
+)
+
+(define-method read_line
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_read_line")
+ (return-type "GIOStatus")
+ (parameters
+ '("gchar**" "str_return")
+ '("gsize*" "length")
+ '("gsize*" "terminator_pos")
+ '("GError**" "error")
+ )
+)
+
+(define-method read_line_string
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_read_line_string")
+ (return-type "GIOStatus")
+ (parameters
+ '("GString*" "buffer")
+ '("gsize*" "terminator_pos")
+ '("GError**" "error")
+ )
+)
+
+(define-method read_to_end
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_read_to_end")
+ (return-type "GIOStatus")
+ (parameters
+ '("gchar**" "str_return")
+ '("gsize*" "length")
+ '("GError**" "error")
+ )
+)
+
+(define-method read_chars
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_read_chars")
+ (return-type "GIOStatus")
+ (parameters
+ '("gchar*" "buf")
+ '("gsize" "count")
+ '("gsize*" "bytes_read")
+ '("GError**" "error")
+ )
+)
+
+(define-method read_unichar
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_read_unichar")
+ (return-type "GIOStatus")
+ (parameters
+ '("gunichar*" "thechar")
+ '("GError**" "error")
+ )
+)
+
+(define-method write_chars
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_write_chars")
+ (return-type "GIOStatus")
+ (parameters
+ '("const-gchar*" "buf")
+ '("gssize" "count")
+ '("gsize*" "bytes_written")
+ '("GError**" "error")
+ )
+)
+
+(define-method write_unichar
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_write_unichar")
+ (return-type "GIOStatus")
+ (parameters
+ '("gunichar" "thechar")
+ '("GError**" "error")
+ )
+)
+
+(define-method seek_position
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_seek_position")
+ (return-type "GIOStatus")
+ (parameters
+ '("gint64" "offset")
+ '("GSeekType" "type")
+ '("GError**" "error")
+ )
+)
+
+(define-function g_io_channel_new_file
+ (c-name "g_io_channel_new_file")
+ (return-type "GIOChannel*")
+ (parameters
+ '("const-gchar*" "filename")
+ '("const-gchar*" "mode")
+ '("GError**" "error")
+ )
+)
+
+(define-function g_io_channel_error_quark
+ (c-name "g_io_channel_error_quark")
+ (return-type "GQuark")
+)
+
+(define-function g_io_channel_error_from_errno
+ (c-name "g_io_channel_error_from_errno")
+ (return-type "GIOChannelError")
+ (parameters
+ '("gint" "en")
+ )
+)
+
+(define-function g_io_channel_unix_new
+ (c-name "g_io_channel_unix_new")
+ (is-constructor-of "GIoChannelUnix")
+ (return-type "GIOChannel*")
+ (parameters
+ '("int" "fd")
+ )
+)
+
+(define-method unix_get_fd
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_unix_get_fd")
+ (return-type "gint")
+)
+
+(define-method win32_make_pollfd
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_win32_make_pollfd")
+ (return-type "none")
+ (parameters
+ '("GIOCondition" "condition")
+ '("GPollFD*" "fd")
+ )
+)
+
+(define-function g_io_channel_win32_poll
+ (c-name "g_io_channel_win32_poll")
+ (return-type "gint")
+ (parameters
+ '("GPollFD*" "fds")
+ '("gint" "n_fds")
+ '("gint" "timeout_")
+ )
+)
+
+(define-function g_main_poll_win32_msg_add
+ (c-name "g_main_poll_win32_msg_add")
+ (return-type "none")
+ (parameters
+ '("gint" "priority")
+ '("GPollFD*" "fd")
+ '("guint" "hwnd")
+ )
+)
+
+(define-function g_io_channel_win32_new_messages
+ (c-name "g_io_channel_win32_new_messages")
+ (return-type "GIOChannel*")
+ (parameters
+ '("guint" "hwnd")
+ )
+)
+
+(define-function g_io_channel_win32_new_fd
+ (c-name "g_io_channel_win32_new_fd")
+ (return-type "GIOChannel*")
+ (parameters
+ '("gint" "fd")
+ )
+)
+
+(define-method win32_get_fd
+ (of-object "GIOChannel")
+ (c-name "g_io_channel_win32_get_fd")
+ (return-type "gint")
+)
+
+(define-function g_io_channel_win32_new_socket
+ (c-name "g_io_channel_win32_new_socket")
+ (return-type "GIOChannel*")
+ (parameters
+ '("gint" "socket")
+ )
+)
+
+
;; (snip)
Index: gnome/gobject/ChangeLog
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/gnome/gobject/ChangeLog,v
retrieving revision 1.3
diff -u -p -u -r1.3 ChangeLog
--- gnome/gobject/ChangeLog 1 Jul 2003 16:10:25 -0000 1.3
+++ gnome/gobject/ChangeLog 4 Aug 2003 12:01:20 -0000
@@ -1,3 +1,14 @@
+2003-08-04 Andreas Rottmann <rottmann@users.sourceforge.net>
+
+ * gw-glib-spec.scm: Implemented GError wrapper.
+
+2003-08-02 Andreas Rottmann <rottmann@users.sourceforge.net>
+
+ * defs-support.scm, gw-spec-utils.scm: Support for enums/flags
+ without gtype-id.
+
+ * Makefile.am (GUILE_FLAGS): New variable.
+
2003-06-21 Andy Wingo <wingo@pobox.com>
* gw-spec-utils.scm (gobject:gwrap-class): New function.
Index: gnome/gobject/Makefile.am
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/gnome/gobject/Makefile.am,v
retrieving revision 1.5
diff -u -p -u -r1.5 Makefile.am
--- gnome/gobject/Makefile.am 23 Jul 2003 08:45:22 -0000 1.5
+++ gnome/gobject/Makefile.am 4 Aug 2003 12:01:20 -0000
@@ -112,6 +112,9 @@ SUFFIXES = .x .doc
GUILE_SNARF_CFLAGS = $(DEFS) $(AM_CFLAGS) $(GUILE_CFLAGS) $(GOBJECT_CFLAGS)
+# For overriding from the command line (e.g. --debug)
+GUILE_FLAGS =
+
.c.x:
guile-snarf $(GUILE_SNARF_CFLAGS) $< > $@ \
|| { rm $@; false; }
@@ -121,7 +124,7 @@ GUILE_SNARF_CFLAGS = $(DEFS) $(AM_CFLAGS
guile_filter_doc_snarfage --filter-snarfage) > $@ || { rm $@; false; }
gw-gobject.scm guile-gnome-gw-gobject.c guile-gnome-gw-gobject.h: gw-gobject-spec.scm
- guile -c \
+ guile $(GUILE_FLAGS) -c \
"(set! %load-path (cons \"${G_WRAP_MODULE_DIR}\" %load-path)) \
(set! %load-path (cons \"${top_srcdir}\" %load-path)) \
(primitive-load \"$(srcdir)/gw-gobject-spec.scm\") \
@@ -129,7 +132,7 @@ gw-gobject.scm guile-gnome-gw-gobject.c
mv guile-gnome-gw-gobject.scm gw-gobject.scm
gw-glib.scm guile-gnome-gw-glib.c guile-gnome-gw-glib.h: gw-glib-spec.scm
- guile -c \
+ guile $(GUILE_FLAGS) -c \
"(set! %load-path (cons \"${G_WRAP_MODULE_DIR}\" %load-path)) \
(set! %load-path (cons \"${top_srcdir}\" %load-path)) \
(primitive-load \"$(srcdir)/gw-glib-spec.scm\") \
Index: gnome/gobject/defs-support.scm
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/gnome/gobject/defs-support.scm,v
retrieving revision 1.3
diff -u -p -u -r1.3 defs-support.scm
--- gnome/gobject/defs-support.scm 1 Jul 2003 16:10:25 -0000 1.3
+++ gnome/gobject/defs-support.scm 4 Aug 2003 12:01:20 -0000
@@ -123,7 +123,10 @@
(lambda (gwrap-function args)
(let* ((ctype #f)
(gtype-id #f)
- (wrapped-type #f))
+ (wrapped-type #f)
+ (is-enum-or-flags (memv gwrap-function
+ (list gobject:gwrap-enum
+ gobject:gwrap-flags))))
(set! num-types (1+ num-types))
(for-each
(lambda (arg)
@@ -136,15 +139,27 @@
((gtype-id) (set! gtype-id (cadr arg)))
((c-name) (set! ctype (cadr arg)))))
args)
-
- (if (or (not gtype-id) (not ctype))
- (error "Type lacks a c-name or gtype-id:\n\n" args))
-
- (set! wrapped-type (gwrap-function ws ctype gtype-id))
+
+ (if (not ctype)
+ (error "Type lacks a c-name:\n\n" args))
+
+ (if (and (not gtype-id) (not is-enum-or-flags))
+ (error "Non-enum/flags-type lacks a gtype-id:\n\n" args))
+
+ (if (not gtype-id)
+ ;; Do the wrapping of enums/flags without a GType
+ (let ((values #f))
+ (for-each
+ (lambda (arg)
+ (case (car arg)
+ ((values) (set! values (cdr arg)))))
+ args)
+ (set! wrapped-type (gwrap-function ws ctype gtype-id
+ values)))
+ (set! wrapped-type (gwrap-function ws ctype gtype-id)))
+
(register-type (gw:wrapset-get-name ws)
- (if (memv gwrap-function (list
- gobject:gwrap-flags
- gobject:gwrap-enum))
+ (if is-enum-or-flags
ctype
(string-append ctype "*"))
(gw:type-get-name wrapped-type))
Index: gnome/gobject/gw-glib-spec.scm
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/gnome/gobject/gw-glib-spec.scm,v
retrieving revision 1.4
diff -u -p -u -r1.4 gw-glib-spec.scm
--- gnome/gobject/gw-glib-spec.scm 21 Jul 2003 15:42:23 -0000 1.4
+++ gnome/gobject/gw-glib-spec.scm 4 Aug 2003 12:01:20 -0000
@@ -494,9 +494,74 @@
glo)
+ ;;
+ (let* ((gerror (gw:wrap-type ws '<GError>)))
+
+ (define (c-type-name-func typespec)
+ "GError *")
+
+ (define (typespec-options-parser options-form wrapset)
+ (let ((remainder options-form))
+ (set! remainder (delq 'caller-owned remainder))
+ (if (null? remainder)
+ options-form
+ (throw 'gw:bad-typespec
+ "Bad <GError> options form - spurious options: "
+ remainder))))
+
+ (define (c-destructor c-var typespec status-var force?)
+ (list "g_clear_error(&" c-var ");\n"))
+
+ (define (pre-call-arg-ccg param status-var)
+ (let* ((scm-name (gw:param-get-scm-name param))
+ (c-name (gw:param-get-c-name param))
+ (typespec (gw:param-get-typespec param)))
+ (list
+ c-name " = NULL;\n")))
+
+ (define (call-ccg result func-call-code status-var)
+ (list (gw:result-get-c-name result) " = " func-call-code ";\n"))
+
+ (define (call-arg-ccg param)
+ (list "&" (gw:param-get-c-name param)))
+
+ (define (post-call-arg-ccg param status-var)
+ (let* ((c-name (gw:param-get-c-name param))
+ (scm-name (gw:param-get-scm-name param))
+ (typespec (gw:param-get-typespec param)))
+ (list
+ "if (" c-name ") {\n"
+ " SCM scm_gerror = scm_list_3(scm_ulong2num(" c-name "->domain), scm_ulong2num(" c-name "->code), scm_makfrom0str(" c-name "->message));\n"
+ (c-destructor c-name typespec status-var #f)
+ " scm_throw(scm_str2symbol(\"g-error\"), scm_gerror);\n"
+ "}\n")))
+
+ (define (post-call-result-ccg result status-var)
+ (let* ((scm-name (gw:result-get-scm-name result))
+ (c-name (gw:result-get-c-name result))
+ (typespec (gw:result-get-typespec result)))
+ (list
+ (c->scm-ccg scm-name c-name typespec status-var)
+ (c-destructor c-name typespec status-var #f))))
+
+ (gw:type-set-c-type-name-func! gerror c-type-name-func)
+ (gw:type-set-typespec-options-parser! gerror typespec-options-parser)
+
+ (gw:type-set-c-destructor! gerror c-destructor)
+
+ (gw:type-set-pre-call-arg-ccg! gerror pre-call-arg-ccg)
+ (gw:type-set-call-arg-ccg! gerror call-arg-ccg)
+ (gw:type-set-call-ccg! gerror call-ccg)
+ (gw:type-set-post-call-arg-ccg! gerror post-call-arg-ccg)
+ (gw:type-set-post-call-result-ccg! gerror post-call-result-ccg)
+ (gw:type-set-param-visibility! gerror #f)
+
+ gerror)
+
(register-type "guile-gnome-gw-glib" "GList*" 'glist-of)
(register-type "guile-gnome-gw-glib" "GSList*" 'gslist-of)
-
+ (register-type "guile-gnome-gw-glib" "GError**" '<GError>)
+
(load-defs ws "gnome/defs/glib.defs")
ws)
Index: gnome/gobject/gw-spec-utils.scm
===================================================================
RCS file: /cvsroot/guile-gtk/guile-gobject/gnome/gobject/gw-spec-utils.scm,v
retrieving revision 1.3
diff -u -p -u -r1.3 gw-spec-utils.scm
--- gnome/gobject/gw-spec-utils.scm 1 Jul 2003 16:10:25 -0000 1.3
+++ gnome/gobject/gw-spec-utils.scm 4 Aug 2003 12:01:20 -0000
@@ -338,15 +338,32 @@
(define (c-destructor c-var typespec status-var force?)
'())
- (format #f "Wrapping type ~A as a GFlags...\n" ctype)
(gwrap-helper-with-class ws gtype-id ctype c-type-name-func scm->c-ccg c->scm-ccg c-destructor))
+(define (gw-wrap-flags ws ctype values)
+ (let* ((enum (gw:wrap-enumeration ws (string->symbol ctype)
+ ctype))
+ (enum-c-sym
+ (gw:any-str->c-sym-str (symbol->string (gw:type-get-name enum))))
+ (val-alist (map (lambda (l)
+ (cons (string->symbol (caadr l))
+ (cadr (cadr l))))
+ values)))
+ enum))
+
+
+(define (gobject:gwrap-flags ws ctype gtype-id . args)
+ (format #f "Wrapping type ~A as a GFlags...\n" ctype)
+ (if gtype-id
+ (gobject:wrap-flags ws ctype gtype-id)
+ (gw-wrap-flags ws ctype (car args))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Wrap enums, just like flags.
-(define (gobject:gwrap-enum ws ctype gtype-id)
+(define (gobject:gwrap-enum ws ctype gtype-id . args)
;; enums are just guints...
(define (c-type-name-func typespec) ctype)
-
+
(define (scm->c-ccg c-var scm-var typespec status-var)
(list
"if (SCM_TYP16_PREDICATE (scm_tc16_gvalue, " scm-var ")\n"
@@ -370,7 +387,19 @@
'())
(format #f "Wrapping type ~A as a GEnum...\n" ctype)
- (gwrap-helper-with-class ws gtype-id ctype c-type-name-func scm->c-ccg c->scm-ccg c-destructor))
+ (cond
+ (gtype-id
+ (gwrap-helper-with-class ws gtype-id ctype c-type-name-func scm->c-ccg c->scm-ccg c-destructor))
+ (else
+ ;; Wrap enum without GType
+ (let ((values (car args))
+ (enum (gw:wrap-enumeration ws (string->symbol ctype) ctype)))
+ (for-each
+ (lambda (l)
+ (gw:enum-add-value! enum (cadr (cadr l)) (string->symbol (caadr l))))
+ values)
+ enum))))
+
(define (gobject:gwrap-opaque-pointer ws ctype)
(gw:wrap-as-wct ws (glib:type-cname->symbol ctype)
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: g-wrap-1.3.4-mods.patch --]
[-- Type: text/x-patch, Size: 30396 bytes --]
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/ChangeLog g-wrap/ChangeLog
--- g-wrap.orig/ChangeLog 2002-11-08 05:46:51.000000000 +0100
+++ g-wrap/ChangeLog 2003-08-04 15:32:15.000000000 +0200
@@ -1,3 +1,20 @@
+2003-08-04 Andreas Rottmann <rottmann@users.sourceforge.net>
+
+ * g-wrap.scm (gw:param-visibility): New type attribute.
+
+ * test/test-enumeration, test/test-gw-wct, test/test-gtkobj,
+ test/test-gw-glib, test/test-gw-standard: Fixed for VPATH build.
+
+ * rpm/Makefile.am, test/Makefile.am: Fixed for VPATH build.
+
+2003-05-19 Andreas Rottmann <rottmann@users.sourceforge.net>
+
+ * Makefile.am (guilemoduledir),
+ * g-wrap/Makefile.am (gwrapmoduledir): Install into
+ $(datadir)/guile/site instead of fixed configure-time location.
+
+ * g-wrap.scm (gw:call-arg-ccg): New CCG.
+
2002-11-07 Rob Browning <rlb@defaultvalue.org>
* release 1.3.4.
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/Makefile.am g-wrap/Makefile.am
--- g-wrap.orig/Makefile.am 2002-11-07 18:23:43.000000000 +0100
+++ g-wrap/Makefile.am 2003-05-16 14:50:59.000000000 +0200
@@ -1,6 +1,6 @@
SUBDIRS = doc rpm bin g-wrap example test
-guilemoduledir=@GUILEMODDIR@
+guilemoduledir=$(datadir)/guile/site
guilemodule_DATA=@GUILEMOD_TARGET@
EXTRA_DIST = g-wrap.m4 g-wrap.scm
Only in g-wrap: autom4te.cache
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/bin/Makefile.am g-wrap/bin/Makefile.am
--- g-wrap.orig/bin/Makefile.am 2002-11-07 18:23:43.000000000 +0100
+++ g-wrap/bin/Makefile.am 2003-08-04 14:19:12.000000000 +0200
@@ -17,7 +17,7 @@
# Depend on Makefile so that we pick up changes to ../configure
g-wrap: g-wrap.in Makefile
rm -f $@.tmp
- sed < $@.in > $@.tmp \
+ sed < $< > $@.tmp \
-e 's:@-GUILE-@:${GUILE}:' \
-e 's:@-VERSION-@:${VERSION}:' \
-e 's:@-GUILE_MODULE_DIR-@:${GUILEMODDIR}:'
@@ -31,7 +31,7 @@
g-wrap-config: g-wrap-config.in
rm -f $@.tmp
- sed < $@.in > $@.tmp \
+ sed < $< > $@.tmp \
-e 's:@-GUILE-@:${GUILE}:' \
-e 's:@-VERSION-@:${VERSION}:' \
-e 's:@-libdir-@:${libdir}:' \
Only in g-wrap: build
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/g-wrap/Makefile.am g-wrap/g-wrap/Makefile.am
--- g-wrap.orig/g-wrap/Makefile.am 2002-11-07 18:23:43.000000000 +0100
+++ g-wrap/g-wrap/Makefile.am 2003-05-16 14:51:16.000000000 +0200
@@ -1,5 +1,5 @@
-gwrapmoduledir=@GUILEMODDIR@/g-wrap
+gwrapmoduledir=$(datadir)/guile/site/g-wrap
gwrapincludedir = $(includedir)/g-wrap
CLEANFILES =
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/g-wrap/g-wrap-glib.c g-wrap/g-wrap/g-wrap-glib.c
--- g-wrap.orig/g-wrap/g-wrap-glib.c 2002-11-07 18:23:43.000000000 +0100
+++ g-wrap/g-wrap/g-wrap-glib.c 2003-05-11 22:38:56.000000000 +0200
@@ -63,7 +63,7 @@
if (bits00to15_mask == SCM_BOOL_F) {
bits00to15_mask = gh_ulong2scm(0xFFFF);
- scm_protect_object (bits00to15_mask);
+ scm_gc_protect_object (bits00to15_mask);
}
/*
@@ -115,8 +115,8 @@
tmp <<= 32;
minval = gw_glib_gint64_to_scm(tmp);
- scm_protect_object(maxval);
- scm_protect_object(minval);
+ scm_gc_protect_object(maxval);
+ scm_gc_protect_object(minval);
initialized = 1;
}
Only in g-wrap.orig/g-wrap: gw-glib.scm
Only in g-wrap.orig/g-wrap: gw-gtk.scm
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/g-wrap/gw-standard-spec.scm g-wrap/g-wrap/gw-standard-spec.scm
--- g-wrap.orig/g-wrap/gw-standard-spec.scm 2002-11-07 18:23:43.000000000 +0100
+++ g-wrap/g-wrap/gw-standard-spec.scm 2003-05-14 21:30:07.000000000 +0200
@@ -10,13 +10,13 @@
;;;
;;; code stolen from plain simple-types. The same, but different :>
-(define (wrap-simple-ranged-signed-integer-type wrapset
- type-sym
- c-type-name
- scm-minval-text
- scm-maxval-text
- scm->c-form
- c->scm-form)
+(define (wrap-simple-ranged-integer-type wrapset
+ type-sym
+ c-type-name
+ c-minval-text ; for unsigned, #f
+ c-maxval-text
+ scm->c-function
+ c->scm-function)
(define (replace-syms tree alist)
(cond
@@ -39,39 +39,47 @@
(define (global-declarations-ccg type client-wrapset)
(if client-wrapset
- (list "static SCM " minvar ";\n"
+ (list (if c-minval-text
+ (list "static SCM " minvar ";\n")
+ '())
"static SCM " maxvar ";\n")
'()))
;; TODO: maybe use status-var.
(define (global-init-ccg type client-wrapset status-var)
(if client-wrapset
- (list minvar " = " scm-minval-text ";\n"
- "scm_protect_object(" minvar ");\n"
- maxvar " = " scm-maxval-text ";\n"
+ (list (if c-minval-text
+ (list minvar " = " c->scm-function "(" c-minval-text ");\n"
+ "scm_protect_object(" minvar ");\n")
+ '())
+ maxvar " = " c->scm-function "(" c-maxval-text ");\n"
"scm_protect_object(" maxvar ");\n")
'()))
(define (scm->c-ccg c-var scm-var typespec status-var)
- (let ((scm->c-code (replace-syms scm->c-form `((c-var . ,c-var)
- (scm-var . ,scm-var)))))
- (list "if(SCM_FALSEP(scm_integer_p(" scm-var ")))"
- `(gw:error ,status-var type ,scm-var)
- "else if(SCM_FALSEP(scm_geq_p(" scm-var ", " minvar "))"
- " || SCM_FALSEP(scm_leq_p(" scm-var ", " maxvar ")))"
- `(gw:error ,status-var range ,scm-var)
- "else {" scm->c-code "}\n"
- "\n"
- "if(" `(gw:error? ,status-var type) ")"
- `(gw:error ,status-var arg-type)
- "else if(" `(gw:error? ,status-var range) ")"
- `(gw:error ,status-var arg-range))))
+ (list "if(SCM_FALSEP(scm_integer_p(" scm-var ")))"
+ `(gw:error ,status-var type ,scm-var)
+ (if c-minval-text
+ (list
+ "else if(SCM_FALSEP(scm_geq_p(" scm-var ", " minvar "))"
+ " || SCM_FALSEP(scm_leq_p(" scm-var ", " maxvar ")))")
+ (list
+ "else if(SCM_NFALSEP(scm_negative_p(" scm-var "))"
+ " || SCM_FALSEP(scm_leq_p(" scm-var ", " maxvar ")))"))
+ `(gw:error ,status-var range ,scm-var)
+ "else {\n"
+ ;; here we pass NULL and 0 as the callers because we've already
+ ;; checked the bounds on the argument
+ " " c-var " = " scm->c-function "(" scm-var ", 0, NULL);\n"
+ "}\n"
+ "\n"
+ "if(" `(gw:error? ,status-var type) ")"
+ `(gw:error ,status-var arg-type)
+ "else if(" `(gw:error? ,status-var range) ")"
+ `(gw:error ,status-var arg-range)))
-
(define (c->scm-ccg scm-var c-var typespec status-var)
- (replace-syms c->scm-form
- `((c-var . ,c-var)
- (scm-var . ,scm-var))))
+ (list scm-var " = " c->scm-function "(" c-var ");\n"))
(define (pre-call-arg-ccg param status-var)
(let* ((scm-name (gw:param-get-scm-name param))
@@ -105,92 +113,6 @@
simple-type))
-(define (wrap-simple-ranged-unsigned-integer-type wrapset
- type-sym
- c-type-name
- scm-maxval-text
- scm->c-form
- c->scm-form)
-
- (define (replace-syms tree alist)
- (cond
- ((null? tree) tree)
- ((list? tree) (map (lambda (elt) (replace-syms elt alist)) tree))
- ((symbol? tree)
- (let ((expansion (assq-ref alist tree)))
- (if (string? expansion)
- expansion
- (error "Expected string for expansion..."))))
- (else tree)))
-
- (let* ((simple-type (gw:wrap-type wrapset type-sym))
- (c-sym-name (gw:any-str->c-sym-str (symbol->string type-sym)))
- (maxvar (gw:gen-c-tmp (string-append "range_maxval" c-sym-name))))
-
- (define (c-type-name-func typespec)
- c-type-name)
-
- (define (global-declarations-ccg type client-wrapset)
- (if client-wrapset
- (list "static SCM " maxvar ";\n")
- '()))
-
- ;; TODO: maybe use status-var
- (define (global-init-ccg type client-wrapset status-var)
- (if client-wrapset
- (list maxvar " = " scm-maxval-text ";\n"
- "scm_protect_object(" maxvar ");\n")
- '()))
-
- (define (scm->c-ccg c-var scm-var typespec status-var)
- (let ((scm->c-code (replace-syms scm->c-form `((c-var . ,c-var)
- (scm-var . ,scm-var)))))
-
- (list
- "if(SCM_FALSEP(scm_integer_p(" scm-var ")))"
- `(gw:error ,status-var type ,scm-var)
- "else if(SCM_NFALSEP(scm_negative_p(" scm-var "))"
- " || SCM_FALSEP(scm_leq_p(" scm-var ", " maxvar ")))"
- `(gw:error ,status-var range ,scm-var)
- "else {" scm->c-code "}\n")))
-
- (define (c->scm-ccg scm-var c-var typespec status-var)
- (replace-syms c->scm-form
- `((c-var . ,c-var)
- (scm-var . ,scm-var))))
-
- (define (pre-call-arg-ccg param status-var)
- (let* ((scm-name (gw:param-get-scm-name param))
- (c-name (gw:param-get-c-name param))
- (typespec (gw:param-get-typespec param)))
- (list
- (scm->c-ccg c-name scm-name typespec status-var)
- "if(" `(gw:error? ,status-var type) ")"
- `(gw:error ,status-var arg-type)
- "else if(" `(gw:error? ,status-var range) ")"
- `(gw:error ,status-var arg-range))))
-
- (define (call-ccg result func-call-code status-var)
- (list (gw:result-get-c-name result) " = " func-call-code ";\n"))
-
- (define (post-call-result-ccg result status-var)
- (let* ((scm-name (gw:result-get-scm-name result))
- (c-name (gw:result-get-c-name result))
- (typespec (gw:result-get-typespec result)))
- (c->scm-ccg scm-name c-name typespec status-var)))
-
- (gw:type-set-c-type-name-func! simple-type c-type-name-func)
- (gw:type-set-global-declarations-ccg! simple-type global-declarations-ccg)
- (gw:type-set-global-initializations-ccg! simple-type global-init-ccg)
- (gw:type-set-scm->c-ccg! simple-type scm->c-ccg)
- (gw:type-set-c->scm-ccg! simple-type c->scm-ccg)
- (gw:type-set-pre-call-arg-ccg! simple-type pre-call-arg-ccg)
- (gw:type-set-call-ccg! simple-type call-ccg)
- (gw:type-set-post-call-result-ccg! simple-type post-call-result-ccg)
-
- simple-type))
-
-
(let ((ws (gw:new-wrapset "gw-standard"))
(limits-requiring-types '()))
@@ -254,13 +176,20 @@
'(scm-var "= (" c-var ") ? SCM_BOOL_T : SCM_BOOL_F;\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; <gw:char>
+ ;; <gw:char> -- FIXME: scm chars are 0-255, not [-128,127] like c chars
(gw:wrap-simple-type ws '<gw:char> "char"
'("SCM_NFALSEP(scm_char_p(" scm-var "))\n")
'(c-var "= SCM_CHAR(" scm-var ");\n")
'(scm-var "= SCM_MAKE_CHAR(" c-var ");\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:unsigned-char> -- scm chars are bounded to [0,255]
+ (gw:wrap-simple-type ws '<gw:unsigned-char> "unsigned char"
+ '("SCM_NFALSEP(scm_char_p(" scm-var "))\n")
+ '(c-var "= SCM_CHAR(" scm-var ");\n")
+ '(scm-var "= SCM_MAKE_CHAR(" c-var ");\n"))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:float>
(gw:wrap-simple-type ws '<gw:float> "float"
'("SCM_NFALSEP(scm_number_p(" scm-var "))\n")
@@ -275,53 +204,78 @@
'(scm-var "= gh_double2scm(" c-var ");\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:short>
+ (let ((wt (wrap-simple-ranged-integer-type
+ ws '<gw:short> "short"
+ "SHRT_MIN" "SHRT_MAX"
+ "scm_num2short" "scm_short2num")))
+ (set! limits-requiring-types (cons wt limits-requiring-types)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:unsigned-short>
+ (let ((wt (wrap-simple-ranged-integer-type
+ ws '<gw:unsigned-short> "unsigned short"
+ #f "USHRT_MAX"
+ "scm_num2ushort" "scm_ushort2num")))
+ (set! limits-requiring-types (cons wt limits-requiring-types)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:int>
- (let ((wt (wrap-simple-ranged-signed-integer-type
+ (let ((wt (wrap-simple-ranged-integer-type
ws '<gw:int> "int"
- "scm_long2num(INT_MIN)"
- "scm_long2num(INT_MAX)"
- '(c-var "= gh_scm2long(" scm-var ");\n")
- '(scm-var "= gh_long2scm(" c-var ");\n"))))
+ "INT_MIN" "INT_MAX"
+ "scm_num2int" "scm_int2num")))
(set! limits-requiring-types (cons wt limits-requiring-types)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:unsigned-int>
- (let ((wt (wrap-simple-ranged-unsigned-integer-type
+ (let ((wt (wrap-simple-ranged-integer-type
ws '<gw:unsigned-int> "unsigned int"
- "scm_ulong2num(UINT_MAX)"
- '(c-var "= gh_scm2ulong(" scm-var ");\n")
- '(scm-var "= gh_ulong2scm(" c-var ");\n"))))
+ #f "UINT_MAX"
+ "scm_num2uint" "scm_uint2num")))
(set! limits-requiring-types (cons wt limits-requiring-types)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:long>
- (let ((wt (wrap-simple-ranged-signed-integer-type
+ (let ((wt (wrap-simple-ranged-integer-type
ws '<gw:long> "long"
- "scm_long2num(LONG_MIN)"
- "scm_long2num(LONG_MAX)"
- '(c-var "= gh_scm2long(" scm-var ");\n")
- '(scm-var "= gh_long2scm(" c-var ");\n"))))
+ "LONG_MIN" "LONG_MAX"
+ "scm_num2long" "scm_long2num")))
(set! limits-requiring-types (cons wt limits-requiring-types)))
-
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:unsigned-long>
- (let ((wt (wrap-simple-ranged-unsigned-integer-type
+ (let ((wt (wrap-simple-ranged-integer-type
ws '<gw:unsigned-long> "unsigned long"
- "scm_ulong2num(ULONG_MAX)"
- '(c-var "= gh_scm2ulong(" scm-var ");\n")
- '(scm-var "= gh_ulong2scm(" c-var ");\n"))))
+ #f "ULONG_MAX"
+ "scm_num2ulong" "scm_ulong2num")))
(set! limits-requiring-types (cons wt limits-requiring-types)))
-
- ;; long long support is currently unavailable. To fix that, we're
- ;; going to need to do some work to handle broken versions of guile
- ;; (or perhaps just refuse to add long long support for those
- ;; versions. The issue is that some versions of guile in
- ;; libguile/__scm.h just "typedef long long_long" even on platforms
- ;; that have long long's that are larger than long. This is a mess,
- ;; meaning, among other things, that long_long won't be big enough
- ;; to hold LONG_LONG_MAX, etc. yuck. (NOTE: <gw:gint64 should now
- ;; work -- use that as a substitute if you can...)
-
+
+ (if (string>=? (version) "1.6")
+ (begin
+ ;; There's a bit of a mess in some older guiles wrt long long
+ ;; support. I don't know when it was fixed, but I know that the
+ ;; 1.6 series works properly -- apw
+
+ ;; FIXME: how to handle the no-long-longs case nicely?
+ ;; Why can't an honest guy seem to get a hold of LLONG_MAX?
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:long-long>
+ (let ((wt (wrap-simple-ranged-integer-type
+ ws '<gw:long-long> "long long"
+ "((long long)0x7fffffffffffffff)" "((long long)0x8000000000000000)"
+ "scm_num2long_long" "scm_long_long2num")))
+ (set! limits-requiring-types (cons wt limits-requiring-types)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:unsigned-long-long>
+ (let ((wt (wrap-simple-ranged-integer-type
+ ws '<gw:unsigned-long-long> "unsigned long long"
+ #f "((unsigned long long)0xffffffffffffffff)"
+ "scm_num2ulong_long" "scm_ulong_long2num")))
+ (set! limits-requiring-types (cons wt limits-requiring-types)))))
+
(let* ((mchars (gw:wrap-type ws '<gw:mchars>)))
(define (c-type-name-func typespec)
Only in g-wrap.orig/g-wrap: gw-standard.scm
Only in g-wrap.orig/g-wrap: gw-wct.scm
Only in g-wrap: g-wrap-1.3.4
Only in g-wrap: g-wrap-1.3.4.tar.gz
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/g-wrap.scm g-wrap/g-wrap.scm
--- g-wrap.orig/g-wrap.scm 2002-11-07 18:23:44.000000000 +0100
+++ g-wrap/g-wrap.scm 2003-08-04 13:39:44.000000000 +0200
@@ -24,7 +24,7 @@
;; FIXME: What does this one do?
:use-module (g-wrap g-translate))
-(use-modules (ice-9 slib))
+(use-modules (ice-9 slib) (srfi srfi-1))
(if (not (defined? 'simple-format))
(begin
@@ -642,6 +642,9 @@
(define-public (gw:param-get-c-type-name x)
(gw:typespec-get-c-type-name (gw:param-get-typespec x)))
+(define-public (gw:param-visible? x)
+ (gw:type-get-param-visibility (gw:param-get-type x)))
+
(define (param-specs->params param-specs wrapset)
(let loop ((remainder param-specs) (n 0))
(if (null? remainder)
@@ -726,6 +729,10 @@
;;; gw:call-ccg (result func-call-code status-var)
;;; Normally must (at least) assign func-call-code (a string) to C result var.
;;;
+;;; gw:call-arg-ccg (param)
+;;;
+;;; Optional. Can transform the param for the call (e.g. call-by-reference)
+;;;
;;; gw:post-call-result-ccg (result status-var)
;;;
;;; Normally must at least convert the C result and assign it to the
@@ -763,6 +770,11 @@
(define-public (gw:type-get-typespec-options-parser t)
(hashq-ref t 'gw:typespec-options-parser))
+(define-public (gw:type-set-param-visibility! t vis)
+ (hashq-set! t 'gw:param-visibility vis))
+(define-public (gw:type-get-param-visibility t)
+ (hashq-ref t 'gw:param-visibility #t))
+
(define-public (gw:type-set-global-initializations-ccg! t generator)
(hashq-set! t 'gw:global-initializations-ccg generator))
(define-public (gw:type-set-global-declarations-ccg! t generator)
@@ -789,6 +801,8 @@
(hashq-set! t 'gw:pre-call-result-ccg generator))
(define-public (gw:type-set-pre-call-arg-ccg! t generator)
(hashq-set! t 'gw:pre-call-arg-ccg generator))
+(define-public (gw:type-set-call-arg-ccg! t generator)
+ (hashq-set! t 'gw:call-arg-ccg generator))
(define-public (gw:type-set-call-ccg! t generator)
(hashq-set! t 'gw:call-ccg generator))
(define-public (gw:type-set-post-call-arg-ccg! t generator)
@@ -1360,16 +1374,21 @@
(else tree)))
(gw:expand-helper tree param allowed-errors tree))
-(define (make-c-call-param-list params)
+(define (make-c-call-param-list params)
(cond ((null? params) '())
- (else
- (cons
- (list
- (gw:param-get-c-name (car params))
- (if (null? (cdr params))
- ""
- ", "))
- (make-c-call-param-list (cdr params))))))
+ (else
+ (let* ((param (car params))
+ (type (gw:param-get-type param))
+ (call-arg-ccg (hashq-ref type 'gw:call-arg-ccg)))
+ (cons
+ (list
+ (if call-arg-ccg
+ (call-arg-ccg param)
+ (gw:param-get-c-name param))
+ (if (null? (cdr params))
+ ""
+ ", "))
+ (make-c-call-param-list (cdr params)))))))
(define (make-c-wrapper-param-declarations param-list)
(let loop ((params param-list)
@@ -1395,12 +1414,12 @@
description
wrapper-name
wrapper-namestr)
-
- (let ((param-decl (make-c-wrapper-param-declarations params))
- (fn-c-wrapper wrapper-name)
- (fn-c-string wrapper-namestr)
- (nargs (length params))
- (status-var "gw__error_status"))
+ (let* ((scm-params (filter gw:param-visible? params))
+ (param-decl (make-c-wrapper-param-declarations scm-params))
+ (fn-c-wrapper wrapper-name)
+ (fn-c-string wrapper-namestr)
+ (nargs (length scm-params))
+ (status-var "gw__error_status"))
(list
"static char * " fn-c-string " = \"" scheme-sym "\";\n"
@@ -1433,21 +1452,24 @@
(let ((pre-call-ccg
(hashq-ref (gw:param-get-type param) 'gw:pre-call-arg-ccg #f)))
(list
- "/* ARG " (gw:param-get-number param) " */\n"
- "gw__arg_pos++;\n"
- (if (> (gw:param-get-number param) gw:*max-fixed-params*)
+ (if (gw:param-visible? param)
(list
- "if (SCM_NULLP (gw__restargs)) " status-var " = GW__ERR_ARGC;\n"
- "else {\n"
- " " (gw:param-get-scm-name param) " = SCM_CAR(gw__restargs);\n"
- " gw__restargs = SCM_CDR (gw__restargs);\n"
- "}\n")
+ "/* ARG " (gw:param-get-number param) " */\n"
+ "gw__arg_pos++;\n"
+ (if (> (gw:param-get-number param) gw:*max-fixed-params*)
+ (list
+ "if (SCM_NULLP (gw__restargs)) " status-var " = GW__ERR_ARGC;\n"
+ "else {\n"
+ " " (gw:param-get-scm-name param) " = SCM_CAR(gw__restargs);\n"
+ " gw__restargs = SCM_CDR (gw__restargs);\n"
+ "}\n")
+ '())
+ "if (" status-var " != GW__ERR_NONE)"
+ " goto " (if (zero? (gw:param-get-number param))
+ "gw__wrapper_exit;\n"
+ (list "gw__post_call_arg_"
+ (- (gw:param-get-number param) 1) ";\n")))
'())
- "if (" status-var " != GW__ERR_NONE)"
- " goto " (if (zero? (gw:param-get-number param))
- "gw__wrapper_exit;\n"
- (list "gw__post_call_arg_"
- (- (gw:param-get-number param) 1) ";\n"))
"\n{\n"
(if pre-call-ccg
(gw:expand-special-forms
@@ -1455,11 +1477,11 @@
param
'(memory misc type range arg-type arg-range))
" /* no pre-call arg code requested! */\n"))))
- params)
-
- (let ((pre-call-result-ccg
- (hashq-ref (gw:result-get-type result) 'gw:pre-call-result-ccg #f)))
- (list
+ params)
+
+ (let ((pre-call-result-ccg
+ (hashq-ref (gw:result-get-type result) 'gw:pre-call-result-ccg #f)))
+ (list
"if (" status-var " == GW__ERR_NONE)\n"
"{\n"
(if pre-call-result-ccg
@@ -1578,7 +1600,7 @@
(param-specs->description-head
scheme-sym (gw:result-get-type result) param-specs)
new-description))
- (nargs (length params)))
+ (nargs (length (filter gw:param-visible? params))))
(gw:wrapset-add-guile-module-export! wrapset scheme-sym)
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/rpm/Makefile.am g-wrap/rpm/Makefile.am
--- g-wrap.orig/rpm/Makefile.am 2002-11-07 18:23:43.000000000 +0100
+++ g-wrap/rpm/Makefile.am 2003-08-04 14:16:03.000000000 +0200
@@ -15,9 +15,9 @@
## brackets here, instead of the usual @...@. This prevents autoconf
## from substituting the values directly into the left-hand sides of
## the sed substitutions. *sigh*
-spec: spec.in Makefile
+spec: $(srcdir)/spec.in Makefile
rm -f $@.tmp
- sed < $@.in > $@.tmp \
+ sed < $< > $@.tmp \
-e 's:@-GW_RTLIB_VER-@:${GW_MAJ}.${GW_REV}.${GW_AGE}:' \
-e 's:@-GW_RTLIB_MAJ-@:${GW_MAJ}:' \
-e 's:@-VERSION-@:${VERSION}:'
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/test/Makefile.am g-wrap/test/Makefile.am
--- g-wrap.orig/test/Makefile.am 2002-11-07 18:23:42.000000000 +0100
+++ g-wrap/test/Makefile.am 2003-08-04 15:15:55.000000000 +0200
@@ -43,9 +43,10 @@
G_WRAP_MODULE_DIR = ${LOCALPWD}/..
EXTRA_DIST += gw-guile
-EXTRA_DIST += test-gw-wct
+EXTRA_DIST += test-gw-wct test-enumeration test-gtkobj test-gw-glib
+EXTRA_DIST += test-gw-standard guile-test-env
EXTRA_DIST += .cvsignore
-EXTRA_DIST += $(wildcard *-spec.scm)
+EXTRA_DIST += $(wildcard $(srcdir)/*-spec.scm)
# ===========================================================================
@@ -85,7 +86,7 @@
(read-enable 'positions) \
(set! %load-path (cons \"${G_WRAP_MODULE_DIR}\" %load-path)) \
(use-modules (g-wrap)) \
- (primitive-load \"./gw-test-standard-spec.scm\") \
+ (primitive-load \"$(srcdir)/gw-test-standard-spec.scm\") \
(gw:generate-wrapset \"gw-test-standard\")"
CLEANFILES += gw-test-standard.scm gw-test-standard.h gw-test-standard.c gw-test-standard.html gw-test-standard-autogen.h
@@ -105,7 +106,7 @@
(read-enable 'positions) \
(set! %load-path (cons \"${G_WRAP_MODULE_DIR}\" %load-path)) \
(use-modules (g-wrap)) \
- (primitive-load \"./gw-test-enumeration-spec.scm\") \
+ (primitive-load \"$(srcdir)/gw-test-enumeration-spec.scm\") \
(gw:generate-wrapset \"gw-test-enumeration\")"
CLEANFILES += gw-test-enumeration.scm gw-test-enumeration.h gw-test-enumeration.c gw-test-enumeration.html gw-test-enumeration-autogen.h
@@ -127,7 +128,7 @@
(debug-enable 'debug) \
(set! %load-path (cons \"${G_WRAP_MODULE_DIR}\" %load-path)) \
(use-modules (g-wrap)) \
- (primitive-load \"./gw-test-parent-spec.scm\") \
+ (primitive-load \"$(srcdir)/gw-test-parent-spec.scm\") \
(gw:generate-wrapset \"gw-test-parent\")"
CLEANFILES += gw-test-parent.scm gw-test-parent.h gw-test-parent.c gw-test-parent.html gw-test-parent-autogen.h
@@ -144,8 +145,8 @@
guile -c \
"(set! %load-path (cons \"${G_WRAP_MODULE_DIR}\" %load-path)) \
(use-modules (g-wrap)) \
- (primitive-load \"./gw-test-parent-spec.scm\") \
- (primitive-load \"./gw-test-child-spec.scm\") \
+ (primitive-load \"$(srcdir)/gw-test-parent-spec.scm\") \
+ (primitive-load \"$(srcdir)/gw-test-child-spec.scm\") \
(gw:generate-wrapset \"gw-test-child\")"
CLEANFILES += gw-test-child.scm gw-test-child.h gw-test-child.c gw-test-child.html gw-test-child-autogen.h
@@ -167,7 +168,7 @@
(read-enable 'positions) \
(set! %load-path (cons \"${G_WRAP_MODULE_DIR}\" %load-path)) \
(use-modules (g-wrap)) \
- (primitive-load \"./gw-test-glib-spec.scm\") \
+ (primitive-load \"$(srcdir)/gw-test-glib-spec.scm\") \
(gw:generate-wrapset \"gw-test-glib\")"
CLEANFILES += gw-test-glib.scm gw-test-glib.h gw-test-glib.c gw-test-glib.html gw-test-glib-autogen.h
@@ -193,7 +194,4 @@
# </test-gw-gtkobj>
# ====================================================================
-${TESTS}:
- chmod a+x $@
-
.PHONY: ${TESTS}
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/test/test-enumeration g-wrap/test/test-enumeration
--- g-wrap.orig/test/test-enumeration 2002-11-07 18:23:42.000000000 +0100
+++ g-wrap/test/test-enumeration 2003-08-04 15:30:22.000000000 +0200
@@ -1,5 +1,5 @@
#!/bin/sh
-exec ./guile-test-env guile -s "$0" "$@"
+exec ${srcdir:-.}/guile-test-env guile -s "$0" "$@"
!#
(use-modules (gw-test-enumeration))
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/test/test-gtkobj g-wrap/test/test-gtkobj
--- g-wrap.orig/test/test-gtkobj 2002-11-07 18:23:42.000000000 +0100
+++ g-wrap/test/test-gtkobj 2003-08-04 15:29:50.000000000 +0200
@@ -1,5 +1,5 @@
#!/bin/sh
-exec ./guile-test-env guile -s "$0" "$@"
+exec ${srcdir:-.}/guile-test-env guile -s "$0" "$@"
!#
(use-modules (g-wrap gw-gtk-spec))
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/test/test-gw-glib g-wrap/test/test-gw-glib
--- g-wrap.orig/test/test-gw-glib 2002-11-07 18:23:42.000000000 +0100
+++ g-wrap/test/test-gw-glib 2003-08-04 15:29:32.000000000 +0200
@@ -1,5 +1,5 @@
#!/bin/sh
-exec ./guile-test-env guile -s "$0" "$@"
+exec ${srcdir:-.}/guile-test-env guile -s "$0" "$@"
!#
(use-modules (gw-test-glib))
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/test/test-gw-standard g-wrap/test/test-gw-standard
--- g-wrap.orig/test/test-gw-standard 2002-11-07 18:23:42.000000000 +0100
+++ g-wrap/test/test-gw-standard 2003-08-04 15:28:54.000000000 +0200
@@ -1,5 +1,5 @@
#!/bin/sh
-exec ./guile-test-env guile -s "$0" "$@"
+exec ${srcdir:-.}/guile-test-env guile -s "$0" "$@"
!#
(use-modules (gw-test-standard))
diff -xconfigure -xaclocal.m4 -xMakefile.in --recursive -u g-wrap.orig/test/test-gw-wct g-wrap/test/test-gw-wct
--- g-wrap.orig/test/test-gw-wct 2002-11-07 18:23:42.000000000 +0100
+++ g-wrap/test/test-gw-wct 2003-08-04 15:29:20.000000000 +0200
@@ -1,5 +1,5 @@
#!/bin/sh
-exec ./guile-test-env guile -s "$0" "$@"
+exec ${srcdir:-.}/guile-test-env guile -s "$0" "$@"
!#
(use-modules (test gw-test-child))
[-- Attachment #4: Type: text/plain, Size: 276 bytes --]
Regards, Andy
--
Andreas Rottmann | Rotty@ICQ | 118634484@ICQ | a.rottmann@gmx.at
http://www.8ung.at/rotty | GnuPG Key: http://www.8ung.at/rotty/gpg.asc
Fingerprint | DFB4 4EB4 78A4 5EEE 6219 F228 F92F CFC5 01FD 5B62
Make free software, not war!
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2003-08-04 13:55 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2003-08-04 13:55 GError implementation status Andreas Rottmann
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).