[lambda-gtk-cvs] CVS update: lambda-gtk/lambda-gtk-cmusbcl.lisp lambda-gtk/lambda-gtk-openmcl.lisp

[Heinrich Konrad Taube]

Update of /project/lambda-gtk/cvsroot/lambda-gtk
In directory common-lisp.net:/tmp/cvs-serv13588

Modified Files:
	lambda-gtk-cmusbcl.lisp lambda-gtk-openmcl.lisp 
Log Message:
added optional arg typing for define-signal-hander
Date: Fri Dec 31 22:18:04 2004
Author: htaube

Index: lambda-gtk/lambda-gtk-cmusbcl.lisp
diff -u lambda-gtk/lambda-gtk-cmusbcl.lisp:1.1.1.1 lambda-gtk/lambda-gtk-cmusbcl.lisp:1.2
--- lambda-gtk/lambda-gtk-cmusbcl.lisp:1.1.1.1	Tue Nov 30 15:59:31 2004
+++ lambda-gtk/lambda-gtk-cmusbcl.lisp	Fri Dec 31 22:18:03 2004
@@ -674,7 +674,11 @@
 (defgluecode (:export :gtk)
   (defmacro define-signal-handler (name return params &body body)
     (let ((args (loop for p in params
-                   collect `(,p (* t))))
+                      collect 
+                      (if (consp p)
+                        (list (first p)
+                              (parse-alien-type (second p)))
+                        `(,p (* t)))))
           (type (parse-alien-type return)))
       "#+:sbcl"
       `(define-alien-function ,name , (cons type args) , at body)


Index: lambda-gtk/lambda-gtk-openmcl.lisp
diff -u lambda-gtk/lambda-gtk-openmcl.lisp:1.3 lambda-gtk/lambda-gtk-openmcl.lisp:1.4
--- lambda-gtk/lambda-gtk-openmcl.lisp:1.3	Mon Dec 13 03:51:23 2004
+++ lambda-gtk/lambda-gtk-openmcl.lisp	Fri Dec 31 22:18:04 2004
@@ -375,8 +375,9 @@
 (defgluecode (:export :gtk)
   (defmacro define-signal-handler (name return params &body body)
     `(ccl:defcallback ,name ,(nconc (loop for p in params
-                                       collect ':address
-                                       collect p)
+                                          append
+                                          (if (consp p) (reverse p)
+                                              (list :address p)))
                                     (list return))
        , at body)))
 (defgluecode (:export :g) (defun "g-callback" (x) x))