(quail-choose-completion-string): Store

[gnu-emacs] / lisp / emacs-lisp / cl-extra.el

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index d60b277bca6250f99f378235b15b60010c772ac5..2402d799108d2f2d66f6ce864e28a37fd20936c5 100644 (file)
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1,4 +1,4 @@
-;;; cl-extra.el --- Common Lisp extensions for GNU Emacs Lisp (part two)
+;;; cl-extra.el --- Common Lisp features, part 2 -*-byte-compile-dynamic: t;-*-
 
 ;; Copyright (C) 1993 Free Software Foundation, Inc.
 
@@ -19,8 +19,9 @@
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to
-;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
 
 ;;; Commentary:
 
@@ -83,12 +84,13 @@ strings case-insensitively."
   (cond ((eq x y) t)
        ((stringp x)
         (and (stringp y) (= (length x) (length y))
-             (or (equal x y)
-                 (equal (downcase x) (downcase y)))))   ; lazy but simple!
+             (or (string-equal x y)
+                 (string-equal (downcase x) (downcase y)))))   ; lazy but simple!
        ((numberp x)
         (and (numberp y) (= x y)))
        ((consp x)
-        (while (and (consp x) (consp y) (equalp (cl-pop x) (cl-pop y))))
+        (while (and (consp x) (consp y) (equalp (car x) (car y)))
+          (setq x (cdr x) y (cdr y)))
         (and (not (consp x)) (equalp x y)))
        ((vectorp x)
         (and (vectorp y) (= (length x) (length y))
@@ -369,8 +371,8 @@ If so, return the true (non-nil) value returned by PREDICATE."
 (defun isqrt (a)
   "Return the integer square root of the argument."
   (if (and (integerp a) (> a 0))
-      (let ((g (cond ((>= a 1000000) 10000) ((>= a 10000) 1000)
-                    ((>= a 100) 100) (t 10)))
+      (let ((g (cond ((<= a 100) 10) ((<= a 10000) 100)
+                    ((<= a 1000000) 1000) (t a)))
            g2)
        (while (< (setq g2 (/ (+ g (/ a g)) 2)) g)
          (setq g g2))
@@ -379,7 +381,7 @@ If so, return the true (non-nil) value returned by PREDICATE."
 
 (defun cl-expt (x y)
   "Return X raised to the power of Y.  Works only for integer arguments."
-  (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) x 0))
+  (if (<= y 0) (if (= y 0) 1 (if (memq x '(-1 1)) (cl-expt x (- y)) 0))
     (* (if (= (% y 2) 0) 1 x) (cl-expt (* x x) (/ y 2)))))
 (or (and (fboundp 'expt) (subrp (symbol-function 'expt)))
     (defalias 'expt 'cl-expt))
@@ -588,7 +590,7 @@ If START or END is negative, it counts from the end."
 (defun cl-copy-tree (tree &optional vecp)
   "Make a copy of TREE.
 If TREE is a cons cell, this recursively copies both its car and its cdr.
-Constrast to copy-sequence, which copies only along the cdrs.  With second
+Contrast to copy-sequence, which copies only along the cdrs.  With second
 argument VECP, this copies vectors as well as conses."
   (if (consp tree)
       (let ((p (setq tree (copy-list tree))))
@@ -888,7 +890,10 @@ This also does some trivial optimizations to make the form prettier."
                                             cl-closure-vars)
                                     '((quote --cl-rest--)))))))
                 (list (car form) (list* 'lambda (cadadr form) body))))
-          form))
+          (let ((found (assq (cadr form) env)))
+            (if (eq (cadr (caddr found)) 'cl-labels-args)
+                (cl-macroexpand-all (cadr (caddr (cadddr found))) env)
+              form))))
        ((memq (car form) '(defun defmacro))
         (list* (car form) (nth 1 form) (cl-macroexpand-body (cddr form) env)))
        ((and (eq (car form) 'progn) (not (cddr form)))