Restructure ‘mailcap-add-mailcap-entry’

* lisp/net/mailcap.el (mailcap-add-mailcap-entry):
Restructure mailcap-add-mailcap-entry to improve readability.

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 469643dbca4e1734cee165f2884649718fb3ece3..1fa4130339684e9d606e057be65ba6abc49af493 100644 (file)
--- 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.