Mercurial > hg > xemacs-beta
diff lisp/cl/cl-macs.el @ 134:34a5b81f86ba r20-2b1
Import from CVS: tag r20-2b1
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:30:11 +0200 |
parents | dbb370e3c29e |
children | 538048ae2ab8 |
line wrap: on
line diff
--- a/lisp/cl/cl-macs.el Mon Aug 13 09:29:37 2007 +0200 +++ b/lisp/cl/cl-macs.el Mon Aug 13 09:30:11 2007 +0200 @@ -1737,6 +1737,21 @@ (nth 3 method) store-temp) (list 'substring (nth 4 method) from-temp to-temp)))) +(define-setf-method values (&rest args) + (let ((methods (mapcar #'(lambda (x) + (get-setf-method x cl-macro-environment)) + args)) + (store-temp (gensym "--values-store--"))) + (list (apply 'append (mapcar 'first methods)) + (apply 'append (mapcar 'second methods)) + (list store-temp) + (cons 'list + (mapcar #'(lambda (m) + (cl-setf-do-store (cons (car (third m)) (fourth m)) + (list 'pop store-temp))) + methods)) + (cons 'list (mapcar 'fifth methods))))) + ;;; Getting and optimizing setf-methods. (defun get-setf-method (place &optional env) "Return a list of five values describing the setf-method for PLACE.