Mercurial > hg > xemacs-beta

comparison lisp/cl/cl-macs.el @ 134:34a5b81f86ba r20-2b1

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-2b1
author cvs
date Mon, 13 Aug 2007 09:30:11 +0200
parents dbb370e3c29e
children 538048ae2ab8
comparison
equal deleted inserted replaced
133:b27e67717092 134:34a5b81f86ba
1734 (list 'let (list (list (car (nth 2 method)) 1734 (list 'let (list (list (car (nth 2 method))
1735 (list 'cl-set-substring (nth 4 method) 1735 (list 'cl-set-substring (nth 4 method)
1736 from-temp to-temp store-temp))) 1736 from-temp to-temp store-temp)))
1737 (nth 3 method) store-temp) 1737 (nth 3 method) store-temp)
1738 (list 'substring (nth 4 method) from-temp to-temp)))) 1738 (list 'substring (nth 4 method) from-temp to-temp))))
1739
1740 (define-setf-method values (&rest args)
1741 (let ((methods (mapcar #'(lambda (x)
1742 (get-setf-method x cl-macro-environment))
1743 args))
1744 (store-temp (gensym "--values-store--")))
1745 (list (apply 'append (mapcar 'first methods))
1746 (apply 'append (mapcar 'second methods))
1747 (list store-temp)
1748 (cons 'list
1749 (mapcar #'(lambda (m)
1750 (cl-setf-do-store (cons (car (third m)) (fourth m))
1751 (list 'pop store-temp)))
1752 methods))
1753 (cons 'list (mapcar 'fifth methods)))))
1739 1754
1740 ;;; Getting and optimizing setf-methods. 1755 ;;; Getting and optimizing setf-methods.
1741 (defun get-setf-method (place &optional env) 1756 (defun get-setf-method (place &optional env)
1742 "Return a list of five values describing the setf-method for PLACE. 1757 "Return a list of five values describing the setf-method for PLACE.
1743 PLACE may be any Lisp form which can appear as the PLACE argument to 1758 PLACE may be any Lisp form which can appear as the PLACE argument to