diff options
Diffstat (limited to 'lisp/emacs-lisp/cl-lib.el')
| -rw-r--r-- | lisp/emacs-lisp/cl-lib.el | 60 |
1 files changed, 30 insertions, 30 deletions
diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 2bab451dd0c..4208160bd12 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -362,7 +362,7 @@ Call `cl-float-limits' to set this.") (declare-function cl--mapcar-many "cl-extra" (cl-func cl-seqs &optional acc)) -(defun cl-mapcar (cl-func cl-x &rest cl-rest) +(defun cl-mapcar (func x &rest rest) "Apply FUNCTION to each element of SEQ, and make a list of the results. If there are several SEQs, FUNCTION is called with that many arguments, and mapping stops as soon as the shortest list runs out. With just one @@ -370,14 +370,14 @@ SEQ, this is like `mapcar'. With several, it is like the Common Lisp `mapcar' function extended to arbitrary sequence types. \n(fn FUNCTION SEQ...)" (declare (important-return-value t)) - (if cl-rest - (if (or (cdr cl-rest) (nlistp cl-x) (nlistp (car cl-rest))) - (cl--mapcar-many cl-func (cons cl-x cl-rest) 'accumulate) - (let ((cl-res nil) (cl-y (car cl-rest))) - (while (and cl-x cl-y) - (push (funcall cl-func (pop cl-x) (pop cl-y)) cl-res)) - (nreverse cl-res))) - (mapcar cl-func cl-x))) + (if rest + (if (or (cdr rest) (nlistp x) (nlistp (car rest))) + (cl--mapcar-many func (cons x rest) 'accumulate) + (let ((res nil) (y (car rest))) + (while (and x y) + (push (funcall func (pop x) (pop y)) res)) + (nreverse res))) + (mapcar func x))) (cl--defalias 'cl-svref #'aref) @@ -502,38 +502,38 @@ The elements of LIST are not copied, just the list structure itself." (declare-function cl-round "cl-extra" (x &optional y)) (declare-function cl-mod "cl-extra" (x y)) -(defun cl-adjoin (cl-item cl-list &rest cl-keys) +(defun cl-adjoin (item list &rest keys) "Return ITEM consed onto the front of LIST only if it's not already there. Otherwise, return LIST unmodified. \nKeywords supported: :test :test-not :key \n(fn ITEM LIST [KEYWORD VALUE]...)" (declare (important-return-value t) (compiler-macro cl--compiler-macro-adjoin)) - (cond ((or (equal cl-keys '(:test eq)) - (and (null cl-keys) (not (numberp cl-item)))) - (if (memq cl-item cl-list) cl-list (cons cl-item cl-list))) - ((or (equal cl-keys '(:test equal)) (null cl-keys)) - (if (member cl-item cl-list) cl-list (cons cl-item cl-list))) - (t (apply 'cl--adjoin cl-item cl-list cl-keys)))) - -(defun cl-subst (cl-new cl-old cl-tree &rest cl-keys) + (cond ((or (equal keys '(:test eq)) + (and (null keys) (not (numberp item)))) + (if (memq item list) list (cons item list))) + ((or (equal keys '(:test equal)) (null keys)) + (if (member item list) list (cons item list))) + (t (apply 'cl--adjoin item list keys)))) + +(defun cl-subst (new old tree &rest keys) "Substitute NEW for OLD everywhere in TREE (non-destructively). Return a copy of TREE with all elements `eql' to OLD replaced by NEW. \nKeywords supported: :test :test-not :key \n(fn NEW OLD TREE [KEYWORD VALUE]...)" (declare (important-return-value t)) - (if (or cl-keys (and (numberp cl-old) (not (integerp cl-old)))) - (apply 'cl-sublis (list (cons cl-old cl-new)) cl-tree cl-keys) - (cl--do-subst cl-new cl-old cl-tree))) - -(defun cl--do-subst (cl-new cl-old cl-tree) - (cond ((eq cl-tree cl-old) cl-new) - ((consp cl-tree) - (let ((a (cl--do-subst cl-new cl-old (car cl-tree))) - (d (cl--do-subst cl-new cl-old (cdr cl-tree)))) - (if (and (eq a (car cl-tree)) (eq d (cdr cl-tree))) - cl-tree (cons a d)))) - (t cl-tree))) + (if (or keys (and (numberp old) (not (integerp old)))) + (apply 'cl-sublis (list (cons old new)) tree keys) + (cl--do-subst new old tree))) + +(defun cl--do-subst (new old tree) + (cond ((eq tree old) new) + ((consp tree) + (let ((a (cl--do-subst new old (car tree))) + (d (cl--do-subst new old (cdr tree)))) + (if (and (eq a (car tree)) (eq d (cdr tree))) + tree (cons a d)))) + (t tree))) (defsubst cl-acons (key value alist) "Add KEY and VALUE to ALIST. |