(shiftf): Fix more. Simplify.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 55f9f49edf09f270cbee1bfa0bc33d7fe07224c2..a6c59ea220cbc6974d54d36d0c41fe12e4d60505 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,17 @@
+2001-11-30  Stefan Monnier  <monnier@cs.yale.edu>
+
+       * emacs-lisp/cl-macs.el (shiftf): Fix more.  Simplify.
+
 2001-11-29  Stefan Monnier  <monnier@cs.yale.edu>
 
+       * emacs-lisp/crm.el (completing-read-multiple): Better preserve
+       the value of require-match in minibuffer-completion-confirm.
+       Use crm-local-completion-map.
+
+       * emacs-lisp/cl-macs.el (shiftf): Fix the fast case so
+       (let ((a 1) (b 2)) (shiftf a b (cons a b)) b) returns (1 . 2).
+       (cl-make-type-test): Use char-valid-p for `character'.
+
        * info.el (Info-complete-next-re, Info-complete-cache): New vars.
        (Info-complete-menu-item): Rewrite.  Add the ability to search
        several sequential nodes.  Add a simple caching mechanism.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index feb1a2f956b77fc8115c6b5be17da5fc6ee573f9..c4761e93bc62d702f56f67caa1f2cac31b19d297 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1844,23 +1844,14 @@ The form returns true if TAG was found and removed, nil otherwise."
   "(shiftf PLACE PLACE... VAL): shift left among PLACEs.
 Example: (shiftf A B C) sets A to B, B to C, and returns the old A.
 Each PLACE may be a symbol, or any generalized variable allowed by `setf'."
-  (if (not (memq nil (mapcar 'symbolp (butlast (cons place args)))))
-      (list 'prog1 place
-           (let ((sets nil))
-             (while args
-               (cl-push (list 'setq place (car args)) sets)
-               (setq place (cl-pop args)))
-             `(setq ,(cadar sets)
-                    (prog1 ,(caddar sets)
-                      ,@(nreverse (cdr sets))))))
-    (let* ((places (reverse (cons place args)))
-          (form (cl-pop places)))
-      (while places
-       (let ((method (cl-setf-do-modify (cl-pop places) 'unsafe)))
-         (setq form (list 'let* (car method)
-                          (list 'prog1 (nth 2 method)
-                                (cl-setf-do-store (nth 1 method) form))))))
-      form)))
+  (cond
+   ((null args) place)
+   ((symbolp place) `(prog1 ,place (setq ,place (shiftf ,@args))))
+   (t
+    (let ((method (cl-setf-do-modify place 'unsafe)))
+      `(let* ,(car method)
+        (prog1 ,(nth 2 method)
+          ,(cl-setf-do-store (nth 1 method) `(shiftf ,@args))))))))
 
 (defmacro rotatef (&rest args)
   "(rotatef PLACE...): rotate left among PLACEs.