Mercurial > hg > xemacs-beta
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