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) ,@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)) ,@body))) (defgluecode (:export :g) (defun "g-callback" (x) x))