This is the mail archive of the
guile-gtk@sources.redhat.com
mailing list for the Guile project.
Re: (gnome gtk) et al
Andreas Rottmann <a.rottmann@gmx.at> writes:
> Andy Wingo <wingo@pobox.com> 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...
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 <rottmann@users.sourceforge.net>
+
+ * Makefile.am (guilemoduledir),
+ * g-wrap/Makefile.am (gwrapmoduledir): Install into
+ $(datadir)/guile/site instead of fixed configure-time location.
+
+ * g-wrap.scm (gw:call-arg-ccg): New CCG.
+
2002-11-07 Rob Browning <rlb@defaultvalue.org>
* release 1.3.4.
diff -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"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
- ;; <gw:char>
+ ;; <gw:char> -- FIXME: scm chars are 0-255, not [-128,127] like c chars
(gw:wrap-simple-type ws '<gw:char> "char"
'("SCM_NFALSEP(scm_char_p(" scm-var "))\n")
'(c-var "= SCM_CHAR(" scm-var ");\n")
'(scm-var "= SCM_MAKE_CHAR(" c-var ");\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:unsigned-char> -- scm chars are bounded to [0,255]
+ (gw:wrap-simple-type ws '<gw:unsigned-char> "unsigned char"
+ '("SCM_NFALSEP(scm_char_p(" scm-var "))\n")
+ '(c-var "= SCM_CHAR(" scm-var ");\n")
+ '(scm-var "= SCM_MAKE_CHAR(" c-var ");\n"))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:float>
(gw:wrap-simple-type ws '<gw:float> "float"
'("SCM_NFALSEP(scm_number_p(" scm-var "))\n")
@@ -275,53 +204,78 @@
'(scm-var "= gh_double2scm(" c-var ");\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:short>
+ (let ((wt (wrap-simple-ranged-integer-type
+ ws '<gw:short> "short"
+ "SHRT_MIN" "SHRT_MAX"
+ "scm_num2short" "scm_short2num")))
+ (set! limits-requiring-types (cons wt limits-requiring-types)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:unsigned-short>
+ (let ((wt (wrap-simple-ranged-integer-type
+ ws '<gw:unsigned-short> "unsigned short"
+ #f "USHRT_MAX"
+ "scm_num2ushort" "scm_ushort2num")))
+ (set! limits-requiring-types (cons wt limits-requiring-types)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:int>
- (let ((wt (wrap-simple-ranged-signed-integer-type
+ (let ((wt (wrap-simple-ranged-integer-type
ws '<gw:int> "int"
- "scm_long2num(INT_MIN)"
- "scm_long2num(INT_MAX)"
- '(c-var "= gh_scm2long(" scm-var ");\n")
- '(scm-var "= gh_long2scm(" c-var ");\n"))))
+ "INT_MIN" "INT_MAX"
+ "scm_num2int" "scm_int2num")))
(set! limits-requiring-types (cons wt limits-requiring-types)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:unsigned-int>
- (let ((wt (wrap-simple-ranged-unsigned-integer-type
+ (let ((wt (wrap-simple-ranged-integer-type
ws '<gw:unsigned-int> "unsigned int"
- "scm_ulong2num(UINT_MAX)"
- '(c-var "= gh_scm2ulong(" scm-var ");\n")
- '(scm-var "= gh_ulong2scm(" c-var ");\n"))))
+ #f "UINT_MAX"
+ "scm_num2uint" "scm_uint2num")))
(set! limits-requiring-types (cons wt limits-requiring-types)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:long>
- (let ((wt (wrap-simple-ranged-signed-integer-type
+ (let ((wt (wrap-simple-ranged-integer-type
ws '<gw:long> "long"
- "scm_long2num(LONG_MIN)"
- "scm_long2num(LONG_MAX)"
- '(c-var "= gh_scm2long(" scm-var ");\n")
- '(scm-var "= gh_long2scm(" c-var ");\n"))))
+ "LONG_MIN" "LONG_MAX"
+ "scm_num2long" "scm_long2num")))
(set! limits-requiring-types (cons wt limits-requiring-types)))
-
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; <gw:unsigned-long>
- (let ((wt (wrap-simple-ranged-unsigned-integer-type
+ (let ((wt (wrap-simple-ranged-integer-type
ws '<gw:unsigned-long> "unsigned long"
- "scm_ulong2num(ULONG_MAX)"
- '(c-var "= gh_scm2ulong(" scm-var ");\n")
- '(scm-var "= gh_ulong2scm(" c-var ");\n"))))
+ #f "ULONG_MAX"
+ "scm_num2ulong" "scm_ulong2num")))
(set! limits-requiring-types (cons wt limits-requiring-types)))
-
- ;; long long support is currently unavailable. To fix that, we're
- ;; going to need to do some work to handle broken versions of guile
- ;; (or perhaps just refuse to add long long support for those
- ;; versions. The issue is that some versions of guile in
- ;; libguile/__scm.h just "typedef long long_long" even on platforms
- ;; that have long long's that are larger than long. This is a mess,
- ;; meaning, among other things, that long_long won't be big enough
- ;; to hold LONG_LONG_MAX, etc. yuck. (NOTE: <gw:gint64 should now
- ;; work -- use that as a substitute if you can...)
-
+
+ (if (string>=? (version) "1.6")
+ (begin
+ ;; There's a bit of a mess in some older guiles wrt long long
+ ;; support. I don't know when it was fixed, but I know that the
+ ;; 1.6 series works properly -- apw
+
+ ;; FIXME: how to handle the no-long-longs case nicely?
+ ;; Why can't an honest guy seem to get a hold of LLONG_MAX?
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:long-long>
+ (let ((wt (wrap-simple-ranged-integer-type
+ ws '<gw:long-long> "long long"
+ "((long long)0x7fffffffffffffff)" "((long long)0x8000000000000000)"
+ "scm_num2long_long" "scm_long_long2num")))
+ (set! limits-requiring-types (cons wt limits-requiring-types)))
+
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;; <gw:unsigned-long-long>
+ (let ((wt (wrap-simple-ranged-integer-type
+ ws '<gw:unsigned-long-long> "unsigned long long"
+ #f "((unsigned long long)0xffffffffffffffff)"
+ "scm_num2ulong_long" "scm_ulong_long2num")))
+ (set! limits-requiring-types (cons wt limits-requiring-types)))))
+
(let* ((mchars (gw:wrap-type ws '<gw:mchars>)))
(define (c-type-name-func typespec)
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)
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 <rottmann@users.sourceforge.net>
+
+ * h2def.py: Added --enums-without-gtype option, which will emit
+ the enum and flags defs without gtype-id.
+
2002-01-28 Ariel Rios <ariel@gnu.org>
* 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 <rottmann@users.sourceforge.net>
+
+ * glib-override.defs: Removed some ignore-globs (*_ref, *_unref
+ and *_free), since g-wrap has no automatic reference-counting
+ (or disposal) of objects.
+
+2003-05-19 Andreas Rottmann <rottmann@users.sourceforge.net>
+
+ * glib.defs: Added defs for giochannel.h and gfilutils.h.
+
2003-05-08 Andy Wingo <wingo@pobox.com>
* 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 <rottmann@users.sourceforge.net>
+
+ * 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 <wingo@pobox.com>
* 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 '<GError>)))
+
+ (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**" '<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)
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!