[mcclim-cvs] CVS mcclim

[thenriksen]

Update of /project/mcclim/cvsroot/mcclim
In directory clnet:/tmp/cvs-serv13661

Modified Files:
	presentations.lisp 
Log Message:
Changed the `funcall-presentation-generic-function' macro to cause
fewer compiler warnings. It still yells about "unknown keyword
arguments" because, say, the accept generic function isn't strictly
specified to take, say, :default and :default-type arguments.


--- /project/mcclim/cvsroot/mcclim/presentations.lisp	2007/01/10 11:19:01	1.79
+++ /project/mcclim/cvsroot/mcclim/presentations.lisp	2007/11/19 21:02:58	1.80
@@ -1156,15 +1156,24 @@
   (let ((gf (gethash name *presentation-gf-table*)))
     (unless gf
       (error "~S is not a presentation generic function" name))
-    (let* ((rebound-args (mapcar (lambda (arg)
-				   `(,(gensym "ARG") ,arg))
-				 args))
-	   (gf-name (generic-function-name gf))
-	   (type-spec-var (car (nth (1- (type-arg-position gf)) rebound-args))))
+    (let* ((rebound-args (loop for arg in args
+                            unless (symbolp arg)
+                            collect (list (gensym "ARG"))))
+           (gf-name (generic-function-name gf))
+           (type-spec-var (car (nth (1- (type-arg-position gf)) rebound-args))))
       `(let ,rebound-args
-	 (,gf-name (prototype-or-error (presentation-type-name
-					,type-spec-var))
-		   ,@(mapcar #'car rebound-args))))))
+         (,gf-name (prototype-or-error (presentation-type-name
+                                        ,type-spec-var))
+                   ,@(mapcar #'(lambda (arg)
+                                 ;; Order of evaluation doesn't matter
+                                 ;; for symbols, and this shuts up
+                                 ;; warnings about arguments in a
+                                 ;; keyword position not being
+                                 ;; constant. By the way, why do we
+                                 ;; care about order of evaluation
+                                 ;; here? -trh
+                                 (or (first (find arg rebound-args :key #'second))
+                                     arg)) args))))))
 
 (defmacro apply-presentation-generic-function (name &rest args)
   (let ((gf (gethash name *presentation-gf-table*)))