diff lisp/cl-extra.el @ 5420:b9167d522a9a

Rebase with 21.5 trunk.
author Mats Lidell <matsl@xemacs.org>
date Thu, 28 Oct 2010 23:53:24 +0200
parents 308d34e9f07d 99de5fd48e87
children 8d29f1c4bb98
line wrap: on
line diff
--- a/lisp/cl-extra.el	Wed Oct 27 23:36:14 2010 +0200
+++ b/lisp/cl-extra.el	Thu Oct 28 23:53:24 2010 +0200
@@ -403,11 +403,17 @@
   "Equivalent to (nconc (nreverse X) Y)."
   (nconc (nreverse x) y))
 
+;; XEmacs; check LIST for type and circularity.
 (defun tailp (sublist list)
   "Return true if SUBLIST is a tail of LIST."
-  (while (and (consp list) (not (eq sublist list)))
-    (setq list (cdr list)))
-  (if (numberp sublist) (equal sublist list) (eq sublist list)))
+  (check-argument-type #'listp list)
+  (let ((before list) (evenp t))
+    (while (and (consp list) (not (eq sublist list)))
+      (setq list (cdr list)
+	    evenp (not evenp))
+      (if evenp (setq before (cdr before)))
+      (if (eq before list) (error 'circular-list list)))
+    (eql sublist list)))
 
 (defalias 'cl-copy-tree 'copy-tree)
 
@@ -417,17 +423,9 @@
 (defalias 'get* 'get)
 (defalias 'getf 'plist-get)
 
-(defun cl-set-getf (plist tag val)
-  (let ((p plist))
-    (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
-    (if p (progn (setcar (cdr p) val) plist) (list* tag val plist))))
-
-(defun cl-do-remf (plist tag)
-  (let ((p (cdr plist)))
-    (while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
-    (and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
-
-;; XEmacs change: we have a builtin remprop
+;; XEmacs; these are built-in.
+(defalias 'cl-set-getf 'plist-put)
+(defalias 'cl-do-remf 'plist-remprop)
 (defalias 'cl-remprop 'remprop)
 
 (defun get-properties (plist indicator-list)
@@ -655,6 +653,11 @@
     (prog1 (cl-prettyprint form)
       (message ""))))
 
+;; XEmacs addition; force cl-macs to be available from here on when
+;; compiling files to be dumped.  This is more reasonable than forcing other
+;; files to do the same, multiple times.
+(eval-when-compile (or (cl-compiling-file) (load "cl-macs")))
+
 (run-hooks 'cl-extra-load-hook)
 
 ;; XEmacs addition