[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: [Chicken-users] let-macro
From: |
Tony Garnock-Jones |
Subject: |
Re: [Chicken-users] let-macro |
Date: |
Thu, 16 Dec 2004 11:57:40 +0000 |
User-agent: |
Mozilla Thunderbird 0.8 (Macintosh/20040913) |
I started trying half-heartedly to resurrect it myself the other day (I
assume you're talking about the gtk+ 2.x wrappers rather than the gtk+
1.x wrappers). More work that I could be bothered with, but I did get
round to rewriting that let-macro use into a define-macro. I've attached
a little patch.
Regards,
Tony
Ariel Rios wrote:
I am trying to get that old Gtk glue code back to work.
At some point it requires let-macro; at that moment it was defined
in more-macros.scm but I can't find it.
thanks
ariel
_______________________________________________
Chicken-users mailing list
address@hidden
http://lists.nongnu.org/mailman/listinfo/chicken-users
Index: Makefile
===================================================================
RCS file: /Users/cvsroot/chickenlib/gtk2/Makefile,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -3 -r1.13 -r1.14
--- Makefile 2004/08/02 09:48:14 1.13
+++ Makefile 2004/12/16 11:56:39 1.14
@@ -34,7 +34,7 @@
%.so: %.scm
$(CSCLD) -s -o $@ $<
- strip $@
+# strip $@
gtk/wrap-%.scm: wrap.log
@echo target $@ # required to force the dependency to take hold?
@@ -57,7 +57,7 @@
`find gtk -name "wrap-class-*.o" -print` \
`find gtk -name "wrap-interface-*.o" -print` \
`pkg-config --libs gtk+-2.0 libglade-2.0`
- strip $@
+# strip $@
# $(CSCLD) -s -o $@ gtk/wrap-classes.scm gtk/wrap-class-*.o
gtk/wrap-interface-*.o
@@ -85,8 +85,8 @@
./extract-all-types `pkg-config --cflags gtk+-2.0` > $@
wrap: wrap.scm gobject.so gdk-types gtk-types
- $(CSCLD) -a -o $@ wrap.scm
- strip $@
+ $(CSCLD) -o $@ wrap.scm
+# strip $@
.SECONDARY: \
gtk/wrap-classes.scm \
Index: gobject.scm
===================================================================
RCS file: /Users/cvsroot/chickenlib/gtk2/gobject.scm,v
retrieving revision 1.15
retrieving revision 1.16
diff -u -3 -r1.15 -r1.16
--- gobject.scm 2003/05/19 22:00:29 1.15
+++ gobject.scm 2004/12/16 11:56:39 1.16
@@ -239,28 +239,32 @@
;; gtype-has-value-table? G_TYPE_IS_HAS_VALUE_TABLE
;; </programlisting>
-(let-macro ((defpred (lambda (s)
- (let* ((ss (symbol->string s))
- (cs (string-append "G_TYPE_IS_"
- (string-map (lambda (ch)
- (case ch
- ((#\-) #\_)
- (else ch)))
- (string-upcase
ss))))
- (pn (string->symbol (string-append "gtype-" ss
"?"))))
- `(define (,pn t)
- ((foreign-lambda bool ,cs _gtype)
- (gtype-number t)))))))
- (defpred fundamental)
- (defpred derived)
- (defpred interface)
- (defpred classed)
- (defpred instantiatable) ; -- of course, this should read
"gtype-instantiable?"...
- (defpred derivable)
- (defpred deep-derivable)
- (defpred abstract)
- (defpred value-abstract)
- (defpred has-value-table))
+(define-macro defpred
+ (lambda (s)
+ (let* ((ss (symbol->string s))
+ (cs (string-append "G_TYPE_IS_"
+ (string-map (lambda (ch)
+ (case ch
+ ((#\-) #\_)
+ (else ch)))
+ (string-upcase ss))))
+ (pn (string->symbol (string-append "gtype-" ss "?"))))
+ `(define (,pn t)
+ ((foreign-lambda bool ,cs _gtype)
+ (gtype-number t))))))
+
+(defpred fundamental)
+(defpred derived)
+(defpred interface)
+(defpred classed)
+(defpred instantiatable) ; -- of course, this should read
"gtype-instantiable?"...
+(defpred derivable)
+(defpred deep-derivable)
+(defpred abstract)
+(defpred value-abstract)
+(defpred value-type)
+(define (gtype-has-value-table? t)
+ ((foreign-lambda bool "G_TYPE_HAS_VALUE_TABLE" _gtype) (gtype-number t)))
;;@ Returns the parent type of the passed-in
;;<structname>gtype</structname> record.
Index: wrap.scm
===================================================================
RCS file: /Users/cvsroot/chickenlib/gtk2/wrap.scm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -3 -r1.7 -r1.8
--- wrap.scm 2003/05/19 22:00:29 1.7
+++ wrap.scm 2004/12/16 11:56:39 1.8
@@ -8,9 +8,9 @@
'srfi-37 ;; Command-line option parser
)
-(require 'script-utils)
+;(require 'script-utils)
-(require-for-syntax 'moremacros)
+;(require-for-syntax 'moremacros)
;(require-for-syntax 'srfi-26) ; I'm using cut/cute below
; - they happen to be builtin
; in chicken.
@@ -244,7 +244,7 @@
(lambda ()
(print ";;; -*- scheme -*-")
(print ";;; Auto-generated from file "filename" by wrap.scm")
- (print ";;; $Id: wrap.scm,v 1.7 2003/05/19 22:00:29 tonyg Exp $")
+ (print ";;; $Id: wrap.scm,v 1.8 2004/12/16 11:56:39 tonyg Exp $")
(print *header-string*)
(newline)
(thunk)))))