From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: (qmail 16988 invoked by alias); 20 May 2003 20:08:52 -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 16898 invoked from network); 20 May 2003 20:08:49 -0000 Received: from unknown (HELO octopussy.utanet.at) (213.90.36.45) by sources.redhat.com with SMTP; 20 May 2003 20:08:49 -0000 Received: from patricia.utanet.at ([213.90.36.8]) by octopussy.utanet.at with esmtp (Exim 4.12) id 19IDPk-0002aL-00; Tue, 20 May 2003 22:08:48 +0200 Received: from dsl-242-253.utaonline.at ([212.152.242.253] helo=rotty-ipv4.yi.org) by patricia.utanet.at with esmtp (Exim 4.12) id 19IDPb-00062b-00; Tue, 20 May 2003 22:08:40 +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 19ID8z-0001Tr-00; Tue, 20 May 2003 21:51:29 +0200 Received: from andy by alice.rhinosaur.lan with local (Exim 4.20) id 19ID8y-0000U5-P6; Tue, 20 May 2003 21:51:28 +0200 To: guile-gtk@sources.redhat.com Cc: Ariel Rios , Rob Browning Subject: Re: (gnome gtk) et al References: <20030407144511.GA1489@lark> <1049743589.1933.21.camel@tosca.elektra.com.mx> <20030514085929.GA12304@lark> <87n0hnrmqy.fsf@alice.rotty.yi.org> From: Andreas Rottmann Date: Tue, 20 May 2003 20:08:00 -0000 In-Reply-To: <87n0hnrmqy.fsf@alice.rotty.yi.org> (Andreas Rottmann's message of "Fri, 16 May 2003 16:26:29 +0200") Message-ID: <873cj99z27.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-q2/txt/msg00086.txt.bz2 --=-=-= Content-length: 1847 Andreas Rottmann writes: > Andy Wingo writes: > >> Ariel! Do check out that url, >> http://ambient.2y.net/wingo/tmp/guile-gobject-0.5.0.tar.gz. >> > Wow! Excellent work! > > I played with it a bit, since I need good glib bindings for a project > of mine. I already have made a bit of progress wrapping GError, but > there is one thing that bit me: Wrapping enums that don't have a GType > ID (such as the ones found in GLib, e.g. GIOStatus). > > I think one route to wrap these would be to have h2def.py somehow > realize they don't have a GType ID (don't know if that is feasible) > and as a consequence generate a .def entry without (g-type-id > "foobar"). defs-support.scm could then use plain g-wrap gw:wrap-enum > instead of gobject:gwrap-enum. > I now have kind of implemented GError support; I have attached patches to g-wrap 1.3.4 (the patch includes the gw-standard-spec.scm mods from guile-gobject 0.5.0) and guile-gobject 0.5.0. ChangeLog entries are included. You can now call GError-producing functions like this: -------- (use-modules (gnome glib)) (let ((error '(#f #f #f))) (if (not (g-io-channel-new-file "/ENOENT" "r" error)) (if (= (g-file-error-quark) (car error)) (format #t "file error (~S) opening /ENOENT: ~S\n" (gw:enum-GFileError-val->sym (cadr error) #f) (caddr error))))) -------- Which yields (at least on my system ;-)): ----- file error (noent) opening /ENOENT: "No such file or directory" ----- Flags are also covered: ----- guile> (use-modules (gnome glib) (srfi srfi-1)) guile> (fold logior 0 (map gw:enum-GIOCondition-val->int '(in out))) 5 ----- I'm not quite sure what we could do to make the interface more convient, so please storm your brains... It would be nice if these patches could go upstream... --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=g-wrap-1.3.4-mods.patch Content-Description: Patch necessary for GError support (including gw-standard-spec.scm mods) Content-length: 18151 diff -X /home/andy/etc/am-diff-excludes -r -u g-wrap.orig/ChangeLog g-wrap/ChangeLog --- g-wrap.orig/ChangeLog 2002-11-08 05:46:51.000000000 +0100 +++ g-wrap/ChangeLog 2003-05-19 15:36:01.000000000 +0200 @@ -1,3 +1,11 @@ +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 -X /home/andy/etc/am-diff-excludes -r -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 diff -X /home/andy/etc/am-diff-excludes -r -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 -X /home/andy/etc/am-diff-excludes -r -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; } diff -X /home/andy/etc/am-diff-excludes -r -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) diff -X /home/andy/etc/am-diff-excludes -r -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-05-14 21:46:26.000000000 +0200 @@ -726,6 +726,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 @@ -789,6 +793,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 +1366,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) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=guile-gobject-0.5-mods.patch Content-Description: Patch to enable GError and \"enums without gtype\" Content-length: 30032 diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/ChangeLog guile-gobject/ChangeLog --- guile-gobject.orig/ChangeLog 2003-04-03 17:28:41.000000000 +0200 +++ guile-gobject/ChangeLog 2003-05-19 15:20:43.000000000 +0200 @@ -1,3 +1,8 @@ +2003-05-19 Andreas Rottmann + + * h2def.py: Added --enums-without-gtype option, which will emit + the enum and flags defs without gtype-id. + 2002-01-28 Ariel Rios * configure.in: Bump version number to 0.3.0 diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/gnome/defs/ChangeLog guile-gobject/gnome/defs/ChangeLog --- guile-gobject.orig/gnome/defs/ChangeLog 2003-05-08 19:12:43.000000000 +0200 +++ guile-gobject/gnome/defs/ChangeLog 2003-05-20 21:43:28.000000000 +0200 @@ -1,3 +1,13 @@ +2003-05-20 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. + +2003-05-19 Andreas Rottmann + + * glib.defs: Added defs for giochannel.h and gfilutils.h. + 2003-05-08 Andy Wingo * glib.defs: Added to support GMainLoop, etc. diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/gnome/defs/glib-overrides.defs guile-gobject/gnome/defs/glib-overrides.defs --- guile-gobject.orig/gnome/defs/glib-overrides.defs 2003-05-08 15:39:04.000000000 +0200 +++ guile-gobject/gnome/defs/glib-overrides.defs 2003-05-20 17:15:45.000000000 +0200 @@ -1,10 +1,7 @@ ;; -*- scheme -*- (ignore-glob "_*" - "*_ref" - "*_unref" "*_copy" - "*_free" "*_newv" "*_valist" "*_setv" @@ -20,4 +17,5 @@ (ignore "g_main_context_wait" "g_error_new" - "g_set_error") + "g_set_error" + "g_clear_error") diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/gnome/defs/glib.defs guile-gobject/gnome/defs/glib.defs --- guile-gobject.orig/gnome/defs/glib.defs 2003-05-08 15:42:25.000000000 +0200 +++ guile-gobject/gnome/defs/glib.defs 2003-05-20 21:27:04.000000000 +0200 @@ -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) \ No newline at end of file diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/gnome/gobject/ChangeLog guile-gobject/gnome/gobject/ChangeLog --- guile-gobject.orig/gnome/gobject/ChangeLog 2003-05-08 19:13:30.000000000 +0200 +++ guile-gobject/gnome/gobject/ChangeLog 2003-05-19 15:28:39.000000000 +0200 @@ -1,3 +1,12 @@ +2003-05-19 Andreas Rottmann + + * defs-support.scm, gw-spec-utils.scm: Support for enums/flags + without gtype-id. + + * Makefile.am: Changed -export-dynamic to -module, which seems + more correct according to libtool documentation. + (GUILE_FLAGS): New variable. + 2003-05-08 Andy Wingo * guile-gnome-gobject-primitives.[ch]: Added and exported log handler diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/gnome/gobject/Makefile.am guile-gobject/gnome/gobject/Makefile.am --- guile-gobject.orig/gnome/gobject/Makefile.am 2003-05-10 14:51:21.000000000 +0200 +++ guile-gobject/gnome/gobject/Makefile.am 2003-05-16 17:34:52.000000000 +0200 @@ -48,7 +48,7 @@ libguile_gnome_gobject_la_LIBADD = $(GOBJECT_LIBS) $(GUILE_LIBS) libguile_gnome_gobject_la_LDFLAGS = \ - -export-dynamic + -module # libguile-gnome-gw-gobject (g-wrap support) @@ -63,7 +63,7 @@ $(G_WRAP_LINK_ARGS) libguile-gnome-gobject.la libguile_gnome_gw_gobject_la_LDFLAGS = \ - -export-dynamic + -module # libguile-gnome-gw-glib (g-wrap support for glib) @@ -78,7 +78,7 @@ $(G_WRAP_LINK_ARGS) libguile-gnome-gobject.la libguile_gnome_gw_glib_la_LDFLAGS = \ - -export-dynamic + -module DOT_X_FILES = \ guile-gnome-gobject.x \ @@ -92,6 +92,9 @@ 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; } @@ -101,7 +104,7 @@ 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\") \ @@ -109,7 +112,7 @@ 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\") \ diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/gnome/gobject/defs-support.scm guile-gobject/gnome/gobject/defs-support.scm --- guile-gobject.orig/gnome/gobject/defs-support.scm 2003-05-11 21:46:19.000000000 +0200 +++ guile-gobject/gnome/gobject/defs-support.scm 2003-05-16 18:09:44.000000000 +0200 @@ -121,7 +121,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) @@ -134,15 +137,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)) diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/gnome/gobject/gw-glib-spec.scm guile-gobject/gnome/gobject/gw-glib-spec.scm --- guile-gobject.orig/gnome/gobject/gw-glib-spec.scm 2003-05-11 13:53:25.000000000 +0200 +++ guile-gobject/gnome/gobject/gw-glib-spec.scm 2003-05-19 14:53:34.000000000 +0200 @@ -485,9 +485,107 @@ 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 'callee-owned remainder)) + (if (null? remainder) + options-form + (throw 'gw:bad-typespec + "Bad gerror-of options form - spurious options: " + remainder)))) + + (define (scm-type-check-predicate scm-var) + (list + "(scm_ilength(" scm-var ") == 3 " + " && (SCM_CAR(" scm-var ") == SCM_BOOL_F " + " || (SCM_NFALSEP(scm_integer_p(SCM_CAR(" scm-var ")))" + " && SCM_NFALSEP(scm_integer_p(SCM_CADR(" scm-var ")))" + " && SCM_STRINGP(SCM_CADDR(" scm-var ")))))")) + + (define (scm->c-ccg c-var scm-var typespec status-var) + (list + c-var " = NULL;\n" + "if (!" (scm-type-check-predicate scm-var) ")" + `(gw:error ,status-var type ,scm-var))) + + (define (scm-set-from-c-ccg c-var scm-var typespec status-var) + (list + "if (!" (scm-type-check-predicate scm-var) ")\n" + `(gw:error ,status-var type ,scm-var) + "else if (" c-var " != NULL)\n" + "{\n" + " scm_list_set_x(" scm-var ", SCM_MAKINUM(0), scm_ulong2num((" c-var ")->domain));\n" + " scm_list_set_x(" scm-var ", SCM_MAKINUM(1), scm_ulong2num((" c-var ")->code));\n" + " scm_list_set_x(" scm-var ", SCM_MAKINUM(2), scm_makfrom0str((" c-var ")->message));\n" + "}\n")) + + (define (c->scm-ccg c-var scm-var typespec status-var) + (list + "if (" c-var " == NULL) " scm-var " = SCM_BOOL_F;\n" + "else\n" + scm-var "= scm_list_3(scm_ulong2num((*" c-var ")->domain), scm_ulong2num((*" c-var ")->code), scm_makfrom0str((*" c-var ")->message));\n")) + + (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 + (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 (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 + (scm-set-from-c-ccg c-name scm-name typespec status-var) + (c-destructor c-name typespec status-var #f)))) + + (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-scm->c-ccg! gerror scm->c-ccg) + (gw:type-set-c->scm-ccg! gerror c->scm-ccg) + (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) + + 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) diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/gnome/gobject/gw-spec-utils.scm guile-gobject/gnome/gobject/gw-spec-utils.scm --- guile-gobject.orig/gnome/gobject/gw-spec-utils.scm 2003-05-12 08:43:14.000000000 +0200 +++ guile-gobject/gnome/gobject/gw-spec-utils.scm 2003-05-18 21:26:59.000000000 +0200 @@ -274,7 +274,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Wrap flags, represented on the scheme side as GValues. -(define (gobject:gwrap-flags ws ctype gtype-id) +(define (gobject-wrap-flags ws ctype gtype-id) ;; flags are just guints... (define (c-type-name-func typespec) ctype) @@ -302,15 +302,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" @@ -334,7 +351,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) diff -X /home/andy/etc/am-diff-excludes -r -u guile-gobject.orig/h2def.py guile-gobject/h2def.py --- guile-gobject.orig/h2def.py 2003-05-08 15:18:21.000000000 +0200 +++ guile-gobject/h2def.py 2003-05-16 16:38:29.000000000 +0200 @@ -186,7 +186,7 @@ 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 @@ 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 @@ 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 @@ 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 @@ 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) --=-=-= Content-length: 278 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 It's GNU/Linux dammit! --=-=-=--