Re: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

[Tino Calancha]

"Herring, Davis" <address@hidden> writes:

>> +(defun assq-delete-all-1 (elt alist key)
>> +  (let ((op (if key #'car #'cdr)))
>
> I would just pass `op' instead.  It makes the callers clearer, and
> also avoids the confusion of "use the key, not the value?" vs. "this
> is the key" for the variable `key'.

Thank you Davis, that's a good point!
I have updated the patch with your suggestion:

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
>From f797643263c9d429a08b0e97b8149644c3f5907b Mon Sep 17 00:00:00 2001
From: Tino Calancha <address@hidden>
Date: Mon, 28 Nov 2016 23:28:22 +0900
Subject: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code

See discussion in:
https://lists.gnu.org/archive/html/emacs-devel/2016-11/msg00592.html
* lisp/subr.el (assq-delete-all-1): New defun.
(assq-delete-all, rassq-delete-all): Use it.
* test/lisp/subr-tests.el (subr-test-assq-delete-all): New test.
---
 lisp/subr.el            | 34 ++++++++++++++--------------------
 test/lisp/subr-tests.el | 12 ++++++++++++
 2 files changed, 26 insertions(+), 20 deletions(-)

diff --git a/lisp/subr.el b/lisp/subr.el
index 5da5bf8..8a72853 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -570,35 +570,29 @@ member-ignore-case
     (setq list (cdr list)))
   list)
 
+(defun assq-delete-all-1 (elt alist op)
+  (while (and (consp (car alist))
+              (eq (funcall op (car alist)) elt))
+    (setq alist (cdr alist)))
+  (let ((tail alist))
+    (while (cdr tail)
+      (if (and (consp (cadr tail))
+               (eq (funcall op (cadr tail)) elt))
+          (setcdr tail (cddr tail))
+        (setq tail (cdr tail))))
+    alist))
+
 (defun assq-delete-all (key alist)
   "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)
+  (assq-delete-all-1 key alist #'car))
 
 (defun rassq-delete-all (value alist)
   "Delete from ALIST all elements whose cdr is `eq' to VALUE.
 Return the modified alist.
 Elements of ALIST that are not conses are ignored."
-  (while (and (consp (car alist))
-             (eq (cdr (car alist)) value))
-    (setq alist (cdr alist)))
-  (let ((tail alist) tail-cdr)
-    (while (setq tail-cdr (cdr tail))
-      (if (and (consp (car tail-cdr))
-              (eq (cdr (car tail-cdr)) value))
-         (setcdr tail (cdr tail-cdr))
-       (setq tail tail-cdr))))
-  alist)
+  (assq-delete-all-1 value alist #'cdr))
 
 (defun alist-get (key alist &optional default remove)
   "Return the value associated with KEY in ALIST, using `assq'.
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index ce21290..018c13b 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -224,5 +224,17 @@
               (error-message-string (should-error (version-to-list 
"beta22_8alpha3")))
               "Invalid version syntax: `beta22_8alpha3' (must start with a 
number)"))))
 
+(ert-deftest subr-test-assq-delete-all ()
+  "Tests for `assq-delete-all' and `rassq-delete-all'."
+  (let ((alist '((foo . 1) (bar . 1) (baz . 1) (foo . 2))))
+    (should (equal '((bar . 1) (baz . 1))
+                   (assq-delete-all 'foo (copy-tree alist))))
+    (should (equal '((foo . 2)) (rassq-delete-all 1 (copy-tree alist))))
+    (should (equal alist (assq-delete-all 'qux (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 9 (copy-tree alist))))
+    (should (equal alist
+                   (assq-delete-all (make-symbol "foo") (copy-tree alist))))
+    (should (equal alist (rassq-delete-all 1.0 (copy-tree alist))))))
+
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
-- 
2.10.2

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.4)
 of 2016-11-28
Repository revision: d020ff3eab01f9683485b35c0fc8b17708e9a6d1