Mercurial > hg > xemacs-beta
diff lisp/cl/cl-extra.el @ 2:ac2d302a0011 r19-15b2
Import from CVS: tag r19-15b2
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:46:35 +0200 |
parents | 376386a54a3c |
children | 0293115a14e9 |
line wrap: on
line diff
--- a/lisp/cl/cl-extra.el Mon Aug 13 08:45:53 2007 +0200 +++ b/lisp/cl/cl-extra.el Mon Aug 13 08:46:35 2007 +0200 @@ -20,9 +20,10 @@ ;; You should have received a copy of the GNU General Public License ;; along with XEmacs; see the file COPYING. If not, write to the Free -;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA +;; 02111-1307, USA. -;;; Synched up with: FSF 19.30. +;;; Synched up with: FSF 19.34. ;;; Commentary: @@ -85,11 +86,12 @@ (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) + ;; XEmacs change (while (and (consp x) (consp y) (equalp (cl-pop x) (cl-pop y)))) (and (not (consp x)) (equalp x y))) ((vectorp x) @@ -373,6 +375,7 @@ (defun isqrt (a) "Return the integer square root of the argument." (if (and (integerp a) (> a 0)) + ;; XEmacs change (let ((g (cond ((>= a 1000000) 10000) ((>= a 10000) 1000) ((>= a 100) 100) (t 10))) g2) @@ -383,7 +386,7 @@ (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)) @@ -593,7 +596,7 @@ (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)))) @@ -655,11 +658,12 @@ (defun make-hash-table (&rest cl-keys) "Make an empty Common Lisp-style hash-table. If :test is `eq', `eql', or `equal', this can use XEmacs built-in hash-tables. -In XEmacs, or with a different test, this internally uses a-lists. +In Emacs 19, or with a different test, this internally uses a-lists. Keywords supported: :test :size The Common Lisp keywords :rehash-size and :rehash-threshold are ignored." (let ((cl-test (or (car (cdr (memq ':test cl-keys))) 'eql)) (cl-size (or (car (cdr (memq ':size cl-keys))) 20))) + ;; XEmacs change (if (and (memq cl-test '(eq eql equal)) (fboundp 'make-hashtable)) (funcall 'make-hashtable cl-size cl-test) (list 'cl-hash-table-tag cl-test @@ -893,7 +897,10 @@ 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)))