Subject: bug#57532: Restructure mailcap-add-mailcap-entry to improve readability

From: Felix Dietrich <[email-masked]>
Date: Thu, 01 Sep 2022 23:37:41 +0200

Package: emacs
Tags: patch
Severity: wishlist

Hello,

‘mailcap-add-mailcap-entry’ is written in a way that makes it hard to
follow.  My patch aims to improve its readability.  In order to show
that my modification retains the original functionality, another Patch
adds ERT test cases for this function.  The new version also shows
clearer an issue with the current implementation that causes some
mailcap entries to be forgotten; this is mentioned in a comment.  A
docstring for the function is added as well.

As was suggested by Lars in March on the emacs-devel mailing list [1], I
am submitting my patches now to the bug tracker for them not to be
forgotten (which I should have done then – but life got in the way).  By
now, I have signed the copyright assignment papers, and they have been
processed.

Footnotes:
[1]  Message-ID: <[email-masked]>
     https://lists.gnu.org/archive/html/emacs-devel/2022-03/msg00593.html

-- 
Felix Dietrich

>From d698762f6e0bcb3176e0c2696dc2443aee0496e5 Mon Sep 17 00:00:00 2001
From: Felix Dietrich <[email-masked]>
Date: Mon, 14 Mar 2022 14:01:26 +0100
Subject: [PATCH] =?UTF-8?q?Add=20tests=20for=20=E2=80=98mailcap-add-mailca?=
 =?UTF-8?q?p-entry=E2=80=99?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* test/lisp/net/mailcap-tests.el:
Add tests for ‘mailcap-add-mailcap-entry’
---
 test/lisp/net/mailcap-tests.el | 405 +++++++++++++++++++++++++++++++++
 1 file changed, 405 insertions(+)

diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el
index 188706fc86..c4f011dd1a 100644
--- a/test/lisp/net/mailcap-tests.el
+++ b/test/lisp/net/mailcap-tests.el
@@ -133,4 +133,409 @@
        (mailcap-view-file (ert-resource-file "test.test")))
      (should mailcap--test-result))))
 
+
+
+(ert-deftest mailcap-add-mailcap-entry-new-major ()
+  "Add a major entry not yet in ‘mailcap-mime-data’."
+  (let ((mailcap-mime-data))
+
+    ;; Add a new major entry to a empty ‘mailcap-mime-data’.
+    (mailcap-add-mailcap-entry "major1" "minor1"
+                               (list (cons 'viewer "viewer1"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major1"
+                      ("minor1" . ((viewer . "viewer1")))))))
+
+    ;; Add a new major entry to a non-empty ‘mailcap-mime-data’.
+    (mailcap-add-mailcap-entry "major2" "minor2"
+                               (list (cons 'viewer "viewer2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major2"
+                      ("minor2" . ((viewer . "viewer2"))))
+                     ("major1"
+                      ("minor1" . ((viewer . "viewer1"))))))))
+
+  ;; Same spiel but with extra entries in INFO.
+  (let ((mailcap-mime-data))
+    ;; Add a new major entry to an empty ‘mailcap-mime-data’.
+    (mailcap-add-mailcap-entry "major1" "minor1"
+                               (list (cons 'viewer "viewer1")
+                                     (cons 'print "print1"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major1"
+                      ("minor1" . ((viewer . "viewer1")
+                                   (print . "print1")))))))
+
+    ;; Add a new major entry to a non-empty ‘mailcap-mime-data’.
+    (mailcap-add-mailcap-entry "major2" "minor2"
+                               (list (cons 'viewer "viewer2")
+                                     (cons 'print "print2")
+                                     (cons 'compose "compose2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major2"
+                      ("minor2" . ((viewer . "viewer2")
+                                   (print . "print2")
+                                   (compose . "compose2"))))
+                     ("major1"
+                      ("minor1" . ((viewer . "viewer1")
+                                   (print . "print1")))))))))
+
+
+(ert-deftest mailcap-add-mailcap-entry-new-minor-to-empty-major ()
+  "Add a minor entry to a an empty major entry."
+  (let ((mailcap-mime-data (list (list "major"))))
+    (mailcap-add-mailcap-entry "major" "minor1"
+                               (list (cons 'viewer "viewer1")
+                                     (cons 'print "print1"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor1" . ((viewer . "viewer1")
+                                   (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-new-minor-to-non-empty-major ()
+  "Add a minor to a major entry containing already minor entries."
+  (let ((mailcap-mime-data
+         (list
+          (list "major"
+                (list "minor1"
+                      (cons 'viewer "viewer1")
+                      (cons 'test "test1")
+                      (cons 'print "print1"))))))
+
+    (mailcap-add-mailcap-entry "major" "minor2"
+                               (list (cons 'viewer "viewer2")
+                                     (cons 'test "test2")
+                                     (cons 'print "print2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor2" . ((viewer . "viewer2")
+                                   (test . "test2")
+                                   (print . "print2")))
+                      ("minor1" . ((viewer . "viewer1")
+                                   (test . "test1")
+                                   (print . "print1")))))))
+
+    (mailcap-add-mailcap-entry "major" "minor3"
+                               (list (cons 'viewer "viewer3")
+                                     (cons 'test "test3")
+                                     (cons 'compose "compose3"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor3" . ((viewer . "viewer3")
+                                   (test . "test3")
+                                   (compose . "compose3")))
+                      ("minor2" . ((viewer . "viewer2")
+                                   (test . "test2")
+                                   (print . "print2")))
+                      ("minor1" . ((viewer . "viewer1")
+                                   (test . "test1")
+                                   (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-new-minor-to-various-major-positions ()
+  "Add a new minor entry to major entries at various postions
+in ‘mailcap-mime-data’."
+  (let ((mailcap-mime-data
+         (list
+          (list "major1"
+                (list "minor1.1"
+                      (cons 'viewer "viewer1.1")
+                      (cons 'print "print1.1")))
+          (list "major2"
+                (list "minor2.1"
+                      (cons 'viewer "viewer2.1")
+                      (cons 'print "print2.1")
+                      (cons 'compose "compose2.1")))
+          (list "major3"
+                (list "minor3.1"
+                      (cons 'viewer "viewer3.1")
+                      (cons 'compose "compose3.1")))
+          (list "major4"
+                (list "minor4.1"
+                      (cons 'viewer "viewer4.1")
+                      (cons 'edit "edit4.1"))))))
+
+    ;; Add a minor entry to a major mode at the front of
+    ;; ‘mailcap-mime-data’.
+    (mailcap-add-mailcap-entry "major1" "minor1.2"
+                               (list (cons 'viewer "viewer1.2")
+                                     (cons 'test "test1.2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major1"
+                      ("minor1.2" . ((viewer . "viewer1.2")
+                                     (test . "test1.2")))
+                      ("minor1.1" . ((viewer . "viewer1.1")
+                                     (print . "print1.1"))))
+                     ("major2"
+                      ("minor2.1" . ((viewer . "viewer2.1")
+                                     (print . "print2.1")
+                                     (compose . "compose2.1"))))
+                     ("major3"
+                      ("minor3.1" . ((viewer . "viewer3.1")
+                                     (compose . "compose3.1"))))
+                     ("major4"
+                      ("minor4.1" . ((viewer . "viewer4.1")
+                                     (edit . "edit4.1")))))))
+
+    ;; Add a minor entry to a major mode in the middle of
+    ;; ‘mailcap-mime-data’.
+    (mailcap-add-mailcap-entry "major3" "minor3.2"
+                               (list (cons 'viewer "viewer3.2")
+                                     (cons 'test "test3.2")
+                                     (cons 'compose "compose3.2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major1"
+                      ("minor1.2" . ((viewer . "viewer1.2")
+                                     (test . "test1.2")))
+                      ("minor1.1" . ((viewer . "viewer1.1")
+                                     (print . "print1.1"))))
+                     ("major2"
+                      ("minor2.1" . ((viewer . "viewer2.1")
+                                     (print . "print2.1")
+                                     (compose . "compose2.1"))))
+                     ("major3"
+                      ("minor3.2" . ((viewer . "viewer3.2")
+                                     (test . "test3.2")
+                                     (compose . "compose3.2")))
+                      ("minor3.1" . ((viewer . "viewer3.1")
+                                     (compose . "compose3.1"))))
+                     ("major4"
+                      ("minor4.1" . ((viewer . "viewer4.1")
+                                     (edit . "edit4.1")))))))
+
+    ;; Add a minor entry to a major mode at the end of
+    ;; ‘mailcap-mime-data’.
+    (mailcap-add-mailcap-entry "major4" "minor4.2"
+                               (list (cons 'viewer "viewer4.2")
+                                     (cons 'test "test4.2")
+                                     (cons 'print "print4.2")
+                                     (cons 'compose "compose4.2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major1"
+                      ("minor1.2" . ((viewer . "viewer1.2")
+                                     (test . "test1.2")))
+                      ("minor1.1" . ((viewer . "viewer1.1")
+                                     (print . "print1.1"))))
+                     ("major2"
+                      ("minor2.1" . ((viewer . "viewer2.1")
+                                     (print . "print2.1")
+                                     (compose . "compose2.1"))))
+                     ("major3"
+                      ("minor3.2" . ((viewer . "viewer3.2")
+                                     (test . "test3.2")
+                                     (compose . "compose3.2")))
+                      ("minor3.1" . ((viewer . "viewer3.1")
+                                     (compose . "compose3.1"))))
+                     ("major4"
+                      ("minor4.2" . ((viewer . "viewer4.2")
+                                     (test . "test4.2")
+                                     (print . "print4.2")
+                                     (compose . "compose4.2")))
+                      ("minor4.1" . ((viewer . "viewer4.1")
+                                     (edit . "edit4.1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-existing-with-test-differing-viewer ()
+  "Add a new entry for an already existing major/minor entry."
+
+  ;; The new and the existing entry have each a test info field.
+  (let ((mailcap-mime-data
+         (list
+          (list "major"
+                (list "minor"
+                      (cons 'viewer "viewer1")
+                      (cons 'test "test1")
+                      (cons 'print "print1"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer2")
+                                     (cons 'test "test2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer2")
+                                  (test . "test2")))
+                      ("minor" . ((viewer . "viewer1")
+                                  (test . "test1")
+                                  (print . "print1"))))))))
+
+  ;; Only the new entry has a test info field.
+  (let ((mailcap-mime-data
+         (list
+          (list "major"
+                (list "minor"
+                      (cons 'viewer "viewer1")
+                      (cons 'print "print1"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer2")
+                                     (cons 'test "test2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer2")
+                                  (test . "test2")))
+                      ("minor" . ((viewer . "viewer1")
+                                  (print . "print1"))))))))
+
+  ;; Only the existing entry has a test info field.
+  (let ((mailcap-mime-data
+         (list
+          (list "major"
+                (list "minor"
+                      (cons 'viewer "viewer1")
+                      (cons 'test "test1")
+                      (cons 'print "print1"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer2")))
+                      ("minor" . ((viewer . "viewer1")
+                                  (test . "test1")
+                                  (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-existing-with-test-same-viewer ()
+  "Add a new entry for an already existing major/minor entry."
+  ;; Both the new and the existing entry have each a test info field.
+  (let ((mailcap-mime-data
+         (list
+          (list "major"
+                (list "minor"
+                      (cons 'viewer "viewer")
+                      (cons 'test "test1")
+                      (cons 'print "print1"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer")
+                                     (cons 'test "test2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer")
+                                  (test . "test2")))
+                      ("minor" . ((viewer . "viewer")
+                                  (test . "test1")
+                                  (print . "print1"))))))))
+
+  ;; Only the new entry has a test field.
+  (let ((mailcap-mime-data
+         (list
+          (list "major"
+                (list "minor"
+                      (cons 'viewer "viewer")
+                      (cons 'print "print1"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer")
+                                     (cons 'test "test2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer")
+                                  (test . "test2")))
+                      ("minor" . ((viewer . "viewer")
+                                  (print . "print1"))))))))
+
+  ;; Only the existing entry has a test info field.
+  (let ((mailcap-mime-data
+         (list
+          (list "major"
+                (list "minor"
+                      (cons 'viewer "viewer")
+                      (cons 'test "test1")
+                      (cons 'print "print1"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer")))
+                      ("minor" . ((viewer . "viewer")
+                                  (test . "test1")
+                                  (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-existing-without-test-differing-viewer ()
+  "Add a new entry for an already existing major/minor entry."
+  ;; Both entries do not have test fields.
+  (let ((mailcap-mime-data
+        (list
+         (list "major"
+               (list "minor"
+                     (cons 'viewer "viewer1")
+                     (cons 'print "print1"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer2")
+                                     (cons 'compose "print2"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer2")
+                                     (compose . "print2")))
+                      ("minor" . ((viewer . "viewer1")
+                                  (print . "print1")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-simple-merge ()
+  "Merge entries without tests (no extra info fields in the existing entry)."
+  (let ((mailcap-mime-data
+        (list
+         (list "major"
+               (list "minor"
+                     (cons 'viewer "viewer"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer"))
+                               'mailcap-mime-data)
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer"))))))))
+
+  (let ((mailcap-mime-data
+        (list
+         (list "major"
+               (list "minor"
+                     (cons 'viewer "viewer"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer")
+                                     (cons 'print "print"))
+                               'mailcap-mime-data)
+
+    (should (equal mailcap-mime-data
+                   '(("major"
+                      ("minor" . ((viewer . "viewer")
+                                  (print . "print")))))))))
+
+(ert-deftest mailcap-add-mailcap-entry-erroneous-merge ()
+  "Merge entries without tests (extra info fields in existing entry).
+
+In its current implementation ‘mailcap-add-mailcap-entry’ loses
+extra fields of an entry already existing in ‘mailcap-mime-data’.
+This test does not actually verify a correct result; it merely
+checks whether ‘mailcap-add-mailcap-entry’ behaviour is still the
+incorrect one.  As such, it can be satisfied by any other result
+than the expected and known wrong one, and its success does not
+help to verify the correct addition and merging of an entry."
+  :expected-result :failed
+
+  (let ((mailcap-mime-data
+        (list
+         (list "major"
+               (list "minor"
+                     (cons 'viewer "viewer")
+                     (cons 'print "print"))))))
+    (mailcap-add-mailcap-entry "major" "minor"
+                               (list (cons 'viewer "viewer")
+                                     (cons 'edit "edit"))
+                               'mailcap-mime-data)
+    ;; Has the print field been lost?
+    (should-not (equal mailcap-mime-data
+                       '(("major"
+                          ("minor" . ((viewer . "viewer")
+                                      (edit . "edit")))))))))
+
+
 ;;; mailcap-tests.el ends here
-- 
2.36.1

>From a370e5f9397fbf5abe1e624acbc19ee009c5c7db Mon Sep 17 00:00:00 2001
From: Felix Dietrich <[email-masked]>
Date: Sun, 6 Mar 2022 20:41:41 +0100
Subject: [PATCH] =?UTF-8?q?Restructure=20=E2=80=98mailcap-add-mailcap-entr?=
 =?UTF-8?q?y=E2=80=99?=
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/net/mailcap.el (mailcap-add-mailcap-entry):
Restructure mailcap-add-mailcap-entry to improve readability.
---
 lisp/net/mailcap.el | 56 +++++++++++++++++++++++++++++----------------
 1 file changed, 36 insertions(+), 20 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 469643dbca..1fa4130339 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -716,27 +716,43 @@ 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))
-         (old-major (assoc major (symbol-value storage))))
-    (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))))))))))
+	 (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))
+	   (not (assq 'test info))
+	   (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)
   "Add VIEWER as a handler for TYPE.
-- 
2.36.1