Re: [PATCH] mailcap-add-mailcap-entry: Superfluous setcdr, readability, entry overriding

[Felix Dietrich]

Lars Ingebrigtsen <larsi@gnus.org> writes:

> Felix Dietrich <felix.dietrich@sperrhaken.name> writes:
>
>> The first, relating to readability: I found it quit difficult to follow
>> the flow of the functionʼs code due to its nesting and idiosyncratic
>> order of condition checking.  I want to, therefore, propose a
>> restructured version, which I believe to be functionally equivalent.
>
> Yes, the code is pretty confusing...  so reading the patches, I'm not
> quite sure whether the new one is equivalent or not.  So I think we'd
> want to have a number of tests in mailcap-tests.el to test that the
> results really are equivalent before and after the change, too.

I agree that adding some automated tests is a good idea, but, since I am
not familiar with writing these in Emacs Lisp, I will first have to
spent a bit of time with the ERT manual and the existing tests, before I
cans start writing the tests.  Meanwhile, to shorten the wait ;), here
is a series of patches that go through the transformation steps of
‘mailcap-add-mailcap-entry’ and demonstrate that it is still the same
function (unless I misstepped).  (I donʼt know if this will end up all
that readable and useful; it seemed like a good idea when I started and
might end up as time better spent learning ERT.)



>From 938e2bb38ea43a2cb87c8442c7c3b78a2e587f78 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 03:29:47 +0100
Subject: [PATCH 01/10] =?UTF-8?q?Merge=20the=20inner=20=E2=80=98let?=
 =?UTF-8?q?=E2=80=99=20with=20the=20outer?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Note that it does not matter should there be no old-major:
(assoc minor nil) is valid and will simply yield nil.
---
 lisp/net/mailcap.el | 32 ++++++++++++++++----------------
 1 file changed, 16 insertions(+), 16 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index b65f7c25b8..633d43320e 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -719,26 +719,26 @@ to supply to the test."
 
 (defun mailcap-add-mailcap-entry (major minor info &optional storage)
   (let* ((storage (or storage 'mailcap--computed-mime-data))
-         (old-major (assoc major (symbol-value storage))))
+         (old-major (assoc major (symbol-value storage)))
+         (cur-minor (assoc minor old-major)))
     (if (null old-major)               ; New major area
         (set storage
              (cons (cons major (list (cons minor info)))
                    (symbol-value storage)))
-      (let ((cur-minor (assoc minor old-major)))
-       (cond
-        ((or (null cur-minor)          ; New minor area, or
-             (assq 'test info))        ; Has a test, insert at beginning
-         (setcdr old-major
-                  (cons (cons minor info) (cdr old-major))))
-        ((and (not (assq 'test info))  ; No test info, replace completely
-              (not (assq 'test cur-minor))
-              (equal (assq 'viewer info)  ; Keep alternative viewer
-                     (assq 'viewer cur-minor)))
-         (setcdr cur-minor info))
-        (t
-         (setcdr old-major
-                  (setcdr old-major
-                          (cons (cons minor info) (cdr old-major))))))))))
+      (cond
+       ((or (null cur-minor)           ; New minor area, or
+           (assq 'test info))  ; Has a test, insert at beginning
+       (setcdr old-major
+                (cons (cons minor info) (cdr old-major))))
+       ((and (not (assq 'test info))   ; No test info, replace completely
+            (not (assq 'test cur-minor))
+            (equal (assq 'viewer info)  ; Keep alternative viewer
+                   (assq 'viewer cur-minor)))
+       (setcdr cur-minor info))
+       (t
+       (setcdr old-major
+                (setcdr old-major
+                        (cons (cons minor info) (cdr old-major)))))))))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.
-- 
2.35.1

>From f9a68bd1696d0cbf9bb07d9178045640cfa02dfc Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 03:30:59 +0100
Subject: [PATCH 02/10] =?UTF-8?q?Move=20the=20=E2=80=98if=E2=80=99=20form?=
 =?UTF-8?q?=20into=20the=20=E2=80=98cond=E2=80=99?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Its condition and then-form become the first alternative of the
‘cond’.  The rest of the ‘cond’ remains, in a way, the previous
else-form of the ‘if’.
---
 lisp/net/mailcap.el | 36 ++++++++++++++++++------------------
 1 file changed, 18 insertions(+), 18 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 633d43320e..c30b9e096d 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -721,24 +721,24 @@ to supply to the test."
   (let* ((storage (or storage 'mailcap--computed-mime-data))
          (old-major (assoc major (symbol-value storage)))
          (cur-minor (assoc minor old-major)))
-    (if (null old-major)               ; New major area
-        (set storage
-             (cons (cons major (list (cons minor info)))
-                   (symbol-value storage)))
-      (cond
-       ((or (null cur-minor)           ; New minor area, or
-           (assq 'test info))  ; Has a test, insert at beginning
-       (setcdr old-major
-                (cons (cons minor info) (cdr old-major))))
-       ((and (not (assq 'test info))   ; No test info, replace completely
-            (not (assq 'test cur-minor))
-            (equal (assq 'viewer info)  ; Keep alternative viewer
-                   (assq 'viewer cur-minor)))
-       (setcdr cur-minor info))
-       (t
-       (setcdr old-major
-                (setcdr old-major
-                        (cons (cons minor info) (cdr old-major)))))))))
+    (cond
+     ((null old-major)         ; New major area
+      (set storage
+           (cons (cons major (list (cons minor info)))
+                 (symbol-value storage))))
+     ((or (null cur-minor)             ; New minor area, or
+         (assq 'test info))    ; Has a test, insert at beginning
+      (setcdr old-major
+              (cons (cons minor info) (cdr old-major))))
+     ((and (not (assq 'test info))     ; No test info, replace completely
+          (not (assq 'test cur-minor))
+          (equal (assq 'viewer info)  ; Keep alternative viewer
+                 (assq 'viewer cur-minor)))
+      (setcdr cur-minor info))
+     (t
+      (setcdr old-major
+              (setcdr old-major
+                      (cons (cons minor info) (cdr old-major))))))))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.
-- 
2.35.1

>From aa5f2640223db603ae158d2177d1bfc73aa0f2f9 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 03:36:17 +0100
Subject: [PATCH 03/10] =?UTF-8?q?Remove=20the=20superfluous=20=E2=80=98set?=
 =?UTF-8?q?cdr=E2=80=99=20call?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

Note the duplication of code in the second and last cond alternatives:
both setcdr calls are identical.
---
 lisp/net/mailcap.el | 3 +--
 1 file changed, 1 insertion(+), 2 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index c30b9e096d..bb34fb86c0 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -737,8 +737,7 @@ to supply to the test."
       (setcdr cur-minor info))
      (t
       (setcdr old-major
-              (setcdr old-major
-                      (cons (cons minor info) (cdr old-major))))))))
+              (cons (cons minor info) (cdr old-major)))))))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.
-- 
2.35.1

>From 4ddb4dbaced88a36ef2a0735c1b911cb60f4f597 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 03:45:09 +0100
Subject: [PATCH 04/10] Add the negated condition of the second to the third
 alternative
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

The negation of the absence of a cur-minor entry (null cur-minor) is
simply cur-minor.  The negation of (assq ’test info) is already
there: (not (assq ’test cur-minor)).

Also: ¬(a ∨ b) = ¬a ∧ ¬b
---
 lisp/net/mailcap.el | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index bb34fb86c0..48701ddee8 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -730,7 +730,8 @@ to supply to the test."
          (assq 'test info))    ; Has a test, insert at beginning
       (setcdr old-major
               (cons (cons minor info) (cdr old-major))))
-     ((and (not (assq 'test info))     ; No test info, replace completely
+     ((and cur-minor
+           (not (assq 'test info))     ; No test info, replace completely
           (not (assq 'test cur-minor))
           (equal (assq 'viewer info)  ; Keep alternative viewer
                  (assq 'viewer cur-minor)))
-- 
2.35.1

>From 2cfb0760c28e2afbb59ad01996b611d28cff47f9 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 03:51:08 +0100
Subject: [PATCH 05/10] Remove the second condition
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

With the conjunction of the negation of the second alternativeʼs
condition with the third alternativeʼs condition in the previous
patch, the second alternative has become redundant, because the
condition of the third alternative now ensure that it will not run in
cases that were previously handled by the second alternative.  Since
the second alternative had the same body-form as the last, that is the
default alternative, it can be correctly handled by the default
alternative as well.
---
 lisp/net/mailcap.el | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 48701ddee8..165945040d 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -726,10 +726,6 @@ to supply to the test."
       (set storage
            (cons (cons major (list (cons minor info)))
                  (symbol-value storage))))
-     ((or (null cur-minor)             ; New minor area, or
-         (assq 'test info))    ; Has a test, insert at beginning
-      (setcdr old-major
-              (cons (cons minor info) (cdr old-major))))
      ((and cur-minor
            (not (assq 'test info))     ; No test info, replace completely
           (not (assq 'test cur-minor))
-- 
2.35.1

>From eb3c3d46e06647976bfebe43dfb18f729cda0d26 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 04:02:58 +0100
Subject: [PATCH 06/10] =?UTF-8?q?Remove=20unnecessary=20=E2=80=98cons?=
 =?UTF-8?q?=E2=80=99=20(move=20=E2=80=98list=E2=80=99=20one=20element=20to?=
 =?UTF-8?q?=20the=20left)?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

(cons something (list something-else)) is the same as
(list something something-else).
---
 lisp/net/mailcap.el | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 165945040d..2d93720a56 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -724,7 +724,7 @@ to supply to the test."
     (cond
      ((null old-major)         ; New major area
       (set storage
-           (cons (cons major (list (cons minor info)))
+           (cons (list major (cons minor info))
                  (symbol-value storage))))
      ((and cur-minor
            (not (assq 'test info))     ; No test info, replace completely
-- 
2.35.1

>From befca96cd7ea332c9bec4136d23dfbc58d0ba805 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 04:20:27 +0100
Subject: [PATCH 07/10] Add extra variables to make things clearer

---
 lisp/net/mailcap.el | 10 ++++++----
 1 file changed, 6 insertions(+), 4 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 2d93720a56..e7575e8097 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -720,12 +720,14 @@ to supply to the test."
 (defun mailcap-add-mailcap-entry (major minor info &optional storage)
   (let* ((storage (or storage 'mailcap--computed-mime-data))
          (old-major (assoc major (symbol-value storage)))
-         (cur-minor (assoc minor old-major)))
+         (cur-minor (assoc minor old-major))
+         (new-minor-entry (cons minor info))
+         new-major)
     (cond
      ((null old-major)         ; New major area
+      (setq new-major (list major new-minor-entry))
       (set storage
-           (cons (list major (cons minor info))
-                 (symbol-value storage))))
+           (cons new-major (symbol-value storage))))
      ((and cur-minor
            (not (assq 'test info))     ; No test info, replace completely
           (not (assq 'test cur-minor))
@@ -734,7 +736,7 @@ to supply to the test."
       (setcdr cur-minor info))
      (t
       (setcdr old-major
-              (cons (cons minor info) (cdr old-major)))))))
+              (cons new-minor-entry (cdr old-major)))))))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.
-- 
2.35.1

>From 293a324649e23a93cfaf6f277fd835340ebdefa9 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 04:36:52 +0100
Subject: [PATCH 08/10] =?UTF-8?q?Use=20macros=20with=20=E2=80=9CGeneralize?=
 =?UTF-8?q?d=20Variables=E2=80=9D?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

For the last one (push new-minor-entry (cdr old-major)) it helped me
to remember that old-major has the form:

("major" ("minor" . info) ("minor" . info))

So, to push a new entry to the front of the list of minor entries, you
push it after "major", that is at the cdr.
---
 lisp/net/mailcap.el | 8 +++-----
 1 file changed, 3 insertions(+), 5 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index e7575e8097..72d292c3e4 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -726,17 +726,15 @@ to supply to the test."
     (cond
      ((null old-major)         ; New major area
       (setq new-major (list major new-minor-entry))
-      (set storage
-           (cons new-major (symbol-value storage))))
+      (push new-major (symbol-value storage)))
      ((and cur-minor
            (not (assq 'test info))     ; No test info, replace completely
           (not (assq 'test cur-minor))
           (equal (assq 'viewer info)  ; Keep alternative viewer
                  (assq 'viewer cur-minor)))
-      (setcdr cur-minor info))
+      (setf (cdr cur-minor) info))
      (t
-      (setcdr old-major
-              (cons new-minor-entry (cdr old-major)))))))
+      (push new-minor-entry (cdr old-major))))))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.
-- 
2.35.1

>From abc8b4410adf05d185c5f9293150d25980567181 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 04:43:45 +0100
Subject: [PATCH 09/10] Clean-up, rename variables, remove comments

---
 lisp/net/mailcap.el | 27 +++++++++++++--------------
 1 file changed, 13 insertions(+), 14 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 72d292c3e4..5d60e7ece4 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -719,22 +719,21 @@ to supply to the test."
 
 (defun mailcap-add-mailcap-entry (major minor info &optional storage)
   (let* ((storage (or storage 'mailcap--computed-mime-data))
-         (old-major (assoc major (symbol-value storage)))
-         (cur-minor (assoc minor old-major))
-         (new-minor-entry (cons minor info))
-         new-major)
+        (major-entry (assoc major (symbol-value storage)))
+        (new-minor-entry (cons minor info))
+        minor-entry)
     (cond
-     ((null old-major)         ; New major area
-      (setq new-major (list major new-minor-entry))
-      (push new-major (symbol-value storage)))
-     ((and cur-minor
-           (not (assq 'test info))     ; No test info, replace completely
-          (not (assq 'test cur-minor))
-          (equal (assq 'viewer info)  ; Keep alternative viewer
-                 (assq 'viewer cur-minor)))
-      (setf (cdr cur-minor) info))
+     ((null major-entry)
+      (setf major-entry (list major new-minor-entry))
+      (push major-entry (symbol-value storage)))
+     ((and (setf minor-entry (assoc minor major-entry))
+          (not (assq 'test info))
+          (not (assq 'test minor-entry))
+          (equal (assq 'viewer info)
+                 (assq 'viewer minor-entry)))
+      (setf (cdr minor-entry) info))
      (t
-      (push new-minor-entry (cdr old-major))))))
+      (push new-minor-entry (cdr major-entry))))))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.
-- 
2.35.1

>From 2e2d02c5ff7bfe939a96a40fcf8fac7e6e255315 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <felix.dietrich@sperrhaken.name>
Date: Thu, 10 Mar 2022 04:44:30 +0100
Subject: [PATCH 10/10] Add docstring and comments (this is the version I sent)

---
 lisp/net/mailcap.el | 21 +++++++++++++++++++++
 1 file changed, 21 insertions(+)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 5d60e7ece4..efcf9d7134 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -718,12 +718,26 @@ to supply to the test."
           result))))
 
 (defun mailcap-add-mailcap-entry (major minor info &optional storage)
+  "Add handler INFO for mime type MAJOR/MINOR to STORAGE.
+
+MAJOR and MINOR should be strings.  MINOR is treated as a regexp
+in later lookups, and, therefore, you may need to escape it
+appropriately.
+
+The format of INFO is described in ‘mailcap-mime-data’.
+
+STORAGE should be a symbol refering to a variable.  The value of
+this variable should have the same format as ‘mailcap-mime-data’.
+STORAGE defaults to ‘mailcap--computed-mime-data’.
+
+None of this is enforced."
   (let* ((storage (or storage 'mailcap--computed-mime-data))
         (major-entry (assoc major (symbol-value storage)))
         (new-minor-entry (cons minor info))
         minor-entry)
     (cond
      ((null major-entry)
+      ;; Add a new major entry containing the new minor entry.
       (setf major-entry (list major new-minor-entry))
       (push major-entry (symbol-value storage)))
      ((and (setf minor-entry (assoc minor major-entry))
@@ -731,8 +745,15 @@ to supply to the test."
           (not (assq 'test minor-entry))
           (equal (assq 'viewer info)
                  (assq 'viewer minor-entry)))
+      ;; Replace a previous MINOR entry if it and the entry to be
+      ;; added both do *not* have a ‘test’ associated in their info
+      ;; alist and both use the same ‘viewer’ command.  This ignores
+      ;; other fields in the previous entryʼs info alist: they will be
+      ;; lost when the info alist in the cdr of the previous entry is
+      ;; replaced with the new INFO alist.
       (setf (cdr minor-entry) info))
      (t
+      ;; Add the new minor entry to the existing major entry.
       (push new-minor-entry (cdr major-entry))))))
 
 (defun mailcap-add (type viewer &optional test)
-- 
2.35.1


-- 
Felix Dietrich