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*)))