From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 29593 invoked by alias); 4 Aug 2003 13:55:10 -0000 Mailing-List: contact guile-gtk-help@sources.redhat.com; run by ezmlm Precedence: bulk List-Subscribe: List-Archive: List-Post: List-Help: , Sender: guile-gtk-owner@sources.redhat.com Received: (qmail 29583 invoked from network); 4 Aug 2003 13:55:06 -0000 Received: from unknown (HELO octopussy.utanet.at) (213.90.36.45) by sources.redhat.com with SMTP; 4 Aug 2003 13:55:06 -0000 Received: from patricia.utanet.at ([213.90.36.8]) by octopussy.utanet.at with esmtp (Exim 4.12) id 19jfnl-0006Ag-00 for guile-gtk@sources.redhat.com; Mon, 04 Aug 2003 15:55:05 +0200 Received: from dsl-243-81.utaonline.at ([212.152.243.81] helo=rotty-ipv4.yi.org) by patricia.utanet.at with esmtp (Exim 4.12) id 19jfng-000396-00 for guile-gtk@sources.redhat.com; Mon, 04 Aug 2003 15:55:00 +0200 Received: from alice.rhinosaur.lan ([192.168.1.3] ident=mail) by rotty-ipv4.yi.org with esmtp (Exim 3.36 #1 (Debian)) id 19jfY0-0000lq-00 for ; Mon, 04 Aug 2003 15:38:48 +0200 Received: from andy by alice.rhinosaur.lan with local (Exim 4.20) id 19jfY0-0002HU-BK for guile-gtk@sources.redhat.com; Mon, 04 Aug 2003 15:38:48 +0200 To: guile-gtk@sources.redhat.com Subject: GError implementation status From: Andreas Rottmann Date: Mon, 04 Aug 2003 13:55:00 -0000 Message-ID: <87y8y9czkn.fsf@alice.rotty.yi.org> User-Agent: Gnus/5.1002 (Gnus v5.10.2) Emacs/21.3 (gnu/linux) MIME-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-SW-Source: 2003-q3/txt/msg00017.txt.bz2 --=-=-= Content-length: 721 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"] | | :2:1: In procedure g-io-channel-new-file in expression (g-io-channel-new-file "/noexist" "r"): | :2:1: unhandled-exception: g-error 59 4 "No such file or directory" | ABORT: (misc-error) | guile> `---- --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=guile-gobject-CVS-mods.patch Content-length: 29810 ? 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 + + * h2def.py: Added --enums-without-gtype option, which will emit + the enum and flags defs without gtype-id. + 2003-05-30 Andy Wingo * gw-standard-spec.scm (, ): 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 + + * 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 + + * glib.defs: Added defs for giochannel.h and gfilutils.h. + 2003-05-25 Andy Wingo * 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 + + * gw-glib-spec.scm: Implemented GError wrapper. + +2003-08-02 Andreas Rottmann + + * 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 * 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 '))) + + (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 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**" ') + (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) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=g-wrap-1.3.4-mods.patch Content-length: 30396 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 + + * 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 + + * 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 * 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")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; - ;; + ;; -- FIXME: scm chars are 0-255, not [-128,127] like c chars (gw:wrap-simple-type ws ' "char" '("SCM_NFALSEP(scm_char_p(" scm-var "))\n") '(c-var "= SCM_CHAR(" scm-var ");\n") '(scm-var "= SCM_MAKE_CHAR(" c-var ");\n")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; -- scm chars are bounded to [0,255] + (gw:wrap-simple-type ws ' "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:wrap-simple-type ws ' "float" '("SCM_NFALSEP(scm_number_p(" scm-var "))\n") @@ -275,53 +204,78 @@ '(scm-var "= gh_double2scm(" c-var ");\n")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + (let ((wt (wrap-simple-ranged-integer-type + ws ' "short" + "SHRT_MIN" "SHRT_MAX" + "scm_num2short" "scm_short2num"))) + (set! limits-requiring-types (cons wt limits-requiring-types))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + (let ((wt (wrap-simple-ranged-integer-type + ws ' "unsigned short" + #f "USHRT_MAX" + "scm_num2ushort" "scm_ushort2num"))) + (set! limits-requiring-types (cons wt limits-requiring-types))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; - (let ((wt (wrap-simple-ranged-signed-integer-type + (let ((wt (wrap-simple-ranged-integer-type ws ' "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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; - (let ((wt (wrap-simple-ranged-unsigned-integer-type + (let ((wt (wrap-simple-ranged-integer-type ws ' "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))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; - (let ((wt (wrap-simple-ranged-signed-integer-type + (let ((wt (wrap-simple-ranged-integer-type ws ' "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))) - + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; - (let ((wt (wrap-simple-ranged-unsigned-integer-type + (let ((wt (wrap-simple-ranged-integer-type ws ' "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: =? (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? + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + (let ((wt (wrap-simple-ranged-integer-type + ws ' "long long" + "((long long)0x7fffffffffffffff)" "((long long)0x8000000000000000)" + "scm_num2long_long" "scm_long_long2num"))) + (set! limits-requiring-types (cons wt limits-requiring-types))) + + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;; + (let ((wt (wrap-simple-ranged-integer-type + ws ' "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 '))) (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 @@ # # ==================================================================== -${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)) --=-=-= Content-length: 276 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! --=-=-=--