branch: externals/compat
commit 63ac5dd347d8def01c00e7bf1e69d12b1b734b8b
Author: Philip Kaludercic <phil...@posteo.net>
Commit: Philip Kaludercic <phil...@posteo.net>
Add assoc-delete-all
---
MANUAL | 1 +
compat-26.el | 18 ++++++++++++++++++
compat-tests.el | 29 +++++++++++++++++++++++++++++
3 files changed, 48 insertions(+)
diff --git a/MANUAL b/MANUAL
index 658a92bb53..e083237c4c 100644
--- a/MANUAL
+++ b/MANUAL
@@ -212,6 +212,7 @@ provided by compat by default:
- Function ~make-nearby-temp-file~ :: See [[info:elisp#Unique File
Names][(elisp) Unique File Names]].
- Variable ~mounted-file-systems~ :: Defined in ~files.el~.
- Function ~temporary-file-directory~ :: See [[info:elisp#Unique File
Names][(elisp) Unique File Names]].
+- Function ~assoc-delete-all~ :: See [[info:elisp#Association Lists][(elisp)
Association Lists]].
These functions are prefixed with ~compat~ prefix, and are only loaded
when ~compat-26~ is required:
diff --git a/compat-26.el b/compat-26.el
index bab8bbbe46..9a6b836cdc 100644
--- a/compat-26.el
+++ b/compat-26.el
@@ -252,6 +252,24 @@ PREFIX is a string, and defaults to \"g\"."
(1+ gensym-counter)))))
(make-symbol (format "%s%d" (or prefix "g") num))))
+(compat-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."
+ :version "26.2"
+ (unless test (setq test #'equal))
+ (while (and (consp (car alist))
+ (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))
+ (funcall test (caar tail-cdr) key))
+ (setcdr tail (cdr tail-cdr))
+ (setq tail tail-cdr))))
+ alist)
+
;;;; Defined in files.el
(declare-function temporary-file-directory nil)
diff --git a/compat-tests.el b/compat-tests.el
index 939e041e52..5271d5d1e5 100644
--- a/compat-tests.el
+++ b/compat-tests.el
@@ -1571,5 +1571,34 @@ the compatibility function."
(compat--should 3 (bool-vector t nil t t))
(compat--error wrong-type-argument (vector))))
+(ert-deftest compat-assoc-delete-all ()
+ "Check if `compat--assoc-delete-all was implemented properly."
+ (compat-test assoc-delete-all
+ (compat--should (list) 0 (list))
+ ;; Test `eq'
+ (compat--should '((1 . one)) 0 (list (cons 1 'one)))
+ (compat--should '((1 . one) a) 0 (list (cons 1 'one) 'a))
+ (compat--should '((1 . one)) 0 (list (cons 0 'zero) (cons 1 'one)))
+ (compat--should '((1 . one)) 0 (list (cons 0 'zero) (cons 0 'zero) (cons 1
'one)))
+ (compat--should '((1 . one)) 0 (list (cons 0 'zero) (cons 1 'one) (cons 0
'zero)))
+ (compat--should '((1 . one) a) 0 (list (cons 0 'zero) (cons 1 'one) 'a
(cons 0 'zero)))
+ (compat--should '(a (1 . one)) 0 (list 'a (cons 0 'zero) (cons 1 'one)
(cons 0 'zero)))
+ ;; Test `equal'
+ (compat--should '(("one" . one)) "zero" (list (cons "one" 'one)))
+ (compat--should '(("one" . one) a) "zero" (list (cons "one" 'one) 'a))
+ (compat--should '(("one" . one)) "zero" (list (cons "zero" 'zero) (cons
"one" 'one)))
+ (compat--should '(("one" . one)) "zero" (list (cons "zero" 'zero) (cons
"zero" 'zero) (cons "one" 'one)))
+ (compat--should '(("one" . one)) "zero" (list (cons "zero" 'zero) (cons
"one" 'one) (cons "zero" 'zero)))
+ (compat--should '(("one" . one) a) "zero" (list (cons "zero" 'zero) (cons
"one" 'one) 'a (cons "zero" 'zero)))
+ (compat--should '(a ("one" . one)) "zero" (list 'a (cons "zero" 'zero)
(cons "one" 'one) (cons "zero" 'zero)))
+ ;; Test custom predicate
+ (compat--should '() 0 (list (cons 1 'one)) #'/=)
+ (compat--should '(a) 0 (list (cons 1 'one) 'a) #'/=)
+ (compat--should '((0 . zero)) 0 (list (cons 0 'zero) (cons 1 'one)) #'/=)
+ (compat--should '((0 . zero) (0 . zero)) 0 (list (cons 0 'zero) (cons 0
'zero) (cons 1 'one)) #'/=)
+ (compat--should '((0 . zero) (0 . zero)) 0 (list (cons 0 'zero) (cons 1
'one) (cons 0 'zero)) #'/=)
+ (compat--should '((0 . zero) a (0 . zero)) 0 (list (cons 0 'zero) (cons 1
'one) 'a (cons 0 'zero)) #'/=)
+ (compat--should '(a (0 . zero) (0 . zero)) 0 (list 'a (cons 0 'zero) (cons
1 'one) (cons 0 'zero)) #'/=)))
+
(provide 'compat-tests)
;;; compat-tests.el ends here
