Mercurial > hg > xemacs-beta
diff lisp/cl.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 bbff29a01820 |
children | 6506fcb40fcf |
line wrap: on
line diff
--- a/lisp/cl.el Wed Oct 27 23:36:14 2010 +0200 +++ b/lisp/cl.el Thu Oct 28 23:53:24 2010 +0200 @@ -363,7 +363,13 @@ (defalias 'first 'car) (defalias 'rest 'cdr) -(defalias 'endp 'null) + +;; XEmacs change; this needs to error if handed a non-list. +(defun endp (list) + "Return t if LIST is nil, or nil if LIST is a cons. Error otherwise." + (prog1 + (null list) + (and list (atom list) (error 'wrong-type-argument #'listp list)))) ;; XEmacs change: make it a real function (defun second (x) @@ -517,24 +523,28 @@ ;;; `last' is implemented as a C primitive, as of 1998-11 -(defun list* (arg &rest rest) ; See compiler macro in cl-macs.el - "Return a new list with specified args as elements, cons'd to last arg. -Thus, `(list* A B C D)' is equivalent to `(nconc (list A B C) D)', or to -`(cons A (cons B (cons C D)))'." - (cond ((not rest) arg) - ((not (cdr rest)) (cons arg (car rest))) - (t (let* ((n (length rest)) - (copy (copy-sequence rest)) - (last (nthcdr (- n 2) copy))) - (setcdr last (car (cdr last))) - (cons arg copy))))) +;;; XEmacs: `list*' is in subr.el. + +;; XEmacs; handle dotted lists properly, error on circularity and if LIST is +;; not a list. +(defun ldiff (list sublist) + "Return a copy of LIST with the tail SUBLIST removed. -(defun ldiff (list sublist) - "Return a copy of LIST with the tail SUBLIST removed." - (let ((res nil)) - (while (and (consp list) (not (eq list sublist))) - (push (pop list) res)) - (nreverse res))) +If SUBLIST is the same Lisp object as LIST, return nil. If SUBLIST is +not present in the list structure of LIST (that is, it is not the cdr +of some cons making up LIST), this function is equivalent to +`copy-list'. LIST may be dotted." + (check-argument-type #'listp list) + (and list (not (eq list sublist)) + (let ((before list) (evenp t) result) + (prog1 + (setq result (list (car list))) + (while (and (setq list (cdr-safe list)) (not (eql list sublist))) + (setcdr result (if (consp list) (list (car list)) list)) + (setq result (cdr result) + evenp (not evenp)) + (if evenp (setq before (cdr before))) + (if (eq before list) (error 'circular-list list))))))) ;;; `copy-list' is implemented as a C primitive, as of 1998-11