[elpa] externals/compat 63ac5dd347 16/27: Add assoc-delete-all

[ELPA Syncer]

branch: externals/compat
commit 63ac5dd347d8def01c00e7bf1e69d12b1b734b8b
Author: Philip Kaludercic <philipk@posteo.net>
Commit: Philip Kaludercic <philipk@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