Commit 9824885f authored by tino calancha's avatar tino calancha
Browse files

Code refactoring assoc-delete-all assq-delete-all

* lisp/subr.el (assoc-delete-all): Add optional arg TEST.
(assq-delete-all): Use assoc-delete-all.

* test/lisp/subr-tests.el (subr-tests--assoc-delete-all)
(subr-tests--assq-delete-all): New tests.

* doc/lispref/lists.texi (Association Lists): Document
assoc-delete-all in the manual.

; * etc/NEWS: Announce assoc-delete-all.
parent 26ee371d
......@@ -1733,6 +1733,14 @@ alist
@end example
@end defun
@defun assoc-delete-all key alist &optional test
This function is like @code{assq-delete-all} except that it accepts
an optional argument @var{test}, a predicate function to compare the
keys in @var{alist}. If omitted or @code{nil}, @var{test} defaults to
@code{equal}. As @code{assq-delete-all}, this function often modifies
the original list structure of @var{alist}.
@end defun
@defun rassq-delete-all value alist
This function deletes from @var{alist} all the elements whose @sc{cdr}
is @code{eq} to @var{value}. It returns the shortened alist, and
......
......@@ -223,6 +223,9 @@ as new-style, bind the new variable 'force-new-style-backquotes' to t.
* Lisp Changes in Emacs 27.1
+++
** New function assoc-delete-all.
** 'print-quoted' now defaults to t, so if you want to see
(quote x) instead of 'x you will have to bind it to nil where applicable.
......
......@@ -705,17 +705,19 @@ Non-strings in LIST are ignored."
(setq list (cdr list)))
list)
(defun assoc-delete-all (key alist)
"Delete from ALIST all elements whose car is `equal' to KEY.
(defun assoc-delete-all (key alist &optional test)
"Delete from ALIST all elements whose car is KEY.
Compare keys with TEST. Defaults to `equal'.
Return the modified alist.
Elements of ALIST that are not conses are ignored."
(unless test (setq test #'equal))
(while (and (consp (car alist))
(equal (car (car alist)) key))
(funcall test (caar alist) key))
(setq alist (cdr alist)))
(let ((tail alist) tail-cdr)
(while (setq tail-cdr (cdr tail))
(if (and (consp (car tail-cdr))
(equal (car (car tail-cdr)) key))
(funcall test (caar tail-cdr) key))
(setcdr tail (cdr tail-cdr))
(setq tail tail-cdr))))
alist)
......@@ -724,16 +726,7 @@ Elements of ALIST that are not conses are ignored."
"Delete from ALIST all elements whose car is `eq' to KEY.
Return the modified alist.
Elements of ALIST that are not conses are ignored."
(while (and (consp (car alist))
(eq (car (car alist)) key))
(setq alist (cdr alist)))
(let ((tail alist) tail-cdr)
(while (setq tail-cdr (cdr tail))
(if (and (consp (car tail-cdr))
(eq (car (car tail-cdr)) key))
(setcdr tail (cdr tail-cdr))
(setq tail tail-cdr))))
alist)
(assoc-delete-all key alist #'eq))
(defun rassq-delete-all (value alist)
"Delete from ALIST all elements whose cdr is `eq' to VALUE.
......
......@@ -26,7 +26,6 @@
;;
;;; Code:
(require 'ert)
(eval-when-compile (require 'cl-lib))
......@@ -307,5 +306,24 @@ cf. Bug#25477."
(should (eq (string-to-char (symbol-name (gensym))) ?g))
(should (eq (string-to-char (symbol-name (gensym "X"))) ?X)))
(ert-deftest subr-tests--assq-delete-all ()
"Test `assq-delete-all' behavior."
(cl-flet ((new-list-fn
()
(list (cons 'a 1) (cons 'b 2) (cons 'c 3) 'd (cons "foo" "bar"))))
(should (equal (cdr (new-list-fn)) (assq-delete-all 'a (new-list-fn))))
(should (equal (new-list-fn) (assq-delete-all 'd (new-list-fn))))
(should (equal (new-list-fn) (assq-delete-all "foo" (new-list-fn))))))
(ert-deftest subr-tests--assoc-delete-all ()
"Test `assoc-delete-all' behavior."
(cl-flet ((new-list-fn
()
(list (cons 'a 1) (cons 'b 2) (cons 'c 3) 'd (cons "foo" "bar"))))
(should (equal (cdr (new-list-fn)) (assoc-delete-all 'a (new-list-fn))))
(should (equal (new-list-fn) (assoc-delete-all 'd (new-list-fn))))
(should (equal (butlast (new-list-fn))
(assoc-delete-all "foo" (new-list-fn))))))
(provide 'subr-tests)
;;; subr-tests.el ends here
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment