(shiftf): Fix more. Simplify.

2 files changed, 20 insertions, 17 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 55f9f49edf0..a6c59ea220c 100644
--- 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 feb1a2f956b..c4761e93bc6 100644
--- 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.