master eab636c: Try to fix mailcap parsing again to respect Emacs defaults

[Lars Ingebrigtsen]

branch: master
commit eab636c7eb25c4e1cbfeb0fc48cc1274e1c55222
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Try to fix mailcap parsing again to respect Emacs defaults
    
    * lisp/net/mailcap.el (mailcap--computed-mime-data): New variable.
    (mailcap-parse-mailcaps): Don't delete Emacs-distributed fallback
    values (bug#40247).
    (mailcap-add-mailcap-entry): Extend to allow working on different
    variables.
    (mailcap-add): Store data in mailcap-user-mime-data, since it
    should be heeded first.
---
 lisp/net/mailcap.el | 60 ++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 39 insertions(+), 21 deletions(-)

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 5fe5b4d..86f9d2b 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -29,6 +29,7 @@
 
 ;;; Code:
 
+(require 'cl-lib)
 (autoload 'mail-header-parse-content-type "mail-parse")
 
 (defgroup mailcap nil
@@ -337,6 +338,10 @@ is a string or list of strings, it represents a shell 
command to run
 to return a true or false shell value for the validity.")
 (put 'mailcap-mime-data 'risky-local-variable t)
 
+(defvar mailcap--computed-mime-data nil
+  "Computed version of the mailcap data incorporating all sources.
+Same format as `mailcap-mime-data'.")
+
 (defcustom mailcap-download-directory nil
   "Directory to which `mailcap-save-binary-file' downloads files by default.
 nil means your home directory."
@@ -422,7 +427,13 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 
1524, plus
   (when (or (not mailcap-parsed-p)
            force)
     ;; Clear out all old data.
-    (setq mailcap-mime-data nil)
+    (setq mailcap--computed-mime-data nil)
+    ;; Add the Emacs-distributed defaults (which will be used as
+    ;; fallbacks).  Do it this way instead of just copying the list,
+    ;; since entries are destructively modified.
+    (cl-loop for (major . minors) in mailcap-mime-data
+             do (cl-loop for (minor . entry) in minors
+                         do (mailcap-add-mailcap-entry major minor entry)))
     (cond
      (path nil)
      ((getenv "MAILCAPS")
@@ -709,10 +720,13 @@ to supply to the test."
           (push (list otest result) mailcap-viewer-test-cache)
           result))))
 
-(defun mailcap-add-mailcap-entry (major minor info)
-  (let ((old-major (assoc major mailcap-mime-data)))
+(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))))
     (if (null old-major)               ; New major area
-       (push (cons major (list (cons minor info))) mailcap-mime-data)
+        (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
@@ -736,11 +750,15 @@ If TEST is not given, it defaults to t."
     (when (or (not (car tl))
              (not (cadr tl)))
       (error "%s is not a valid MIME type" type))
-    (mailcap-add-mailcap-entry
-     (car tl) (cadr tl)
-     `((viewer . ,viewer)
-       (test . ,(if test test t))
-       (type . ,type)))))
+    (let ((entry
+           `((viewer . ,viewer)
+             (test . ,(if test test t))
+             (type . ,type))))
+      ;; Store it.
+      (mailcap-add-mailcap-entry (car tl) (cadr tl) entry
+                                 'mailcap-user-mime-data)
+      ;; Make it available for usage.
+      (mailcap-add-mailcap-entry (car tl) (cadr tl) entry))))
 
 ;;;
 ;;; The main whabbo
@@ -791,13 +809,13 @@ If NO-DECODE is non-nil, don't decode STRING."
   ;; NO-DECODE avoids calling `mail-header-parse-content-type' from
   ;; `mail-parse.el'
   (let (
-       major                           ; Major encoding (text, etc)
-       minor                           ; Minor encoding (html, etc)
-       info                            ; Other info
-       major-info                      ; (assoc major mailcap-mime-data)
-       viewers                         ; Possible viewers
-       passed                          ; Viewers that passed the test
-       viewer                          ; The one and only viewer
+       major              ; Major encoding (text, etc)
+       minor              ; Minor encoding (html, etc)
+       info               ; Other info
+       major-info         ; (assoc major mailcap--computed-mime-data)
+       viewers            ; Possible viewers
+       passed             ; Viewers that passed the test
+       viewer             ; The one and only viewer
        ctl)
     (save-excursion
       (setq ctl
@@ -809,12 +827,12 @@ If NO-DECODE is non-nil, don't decode STRING."
       (if viewer
           (setq passed (list viewer))
         ;; None found, so heuristically select some applicable viewer
-        ;; from `mailcap-mime-data'.
+        ;; from `mailcap--computed-mime-data'.
         (mailcap-parse-mailcaps nil t)
         (setq major (split-string (car ctl) "/"))
         (setq minor (cadr major)
               major (car major))
-        (when (setq major-info (cdr (assoc major mailcap-mime-data)))
+        (when (setq major-info (cdr (assoc major mailcap--computed-mime-data)))
           (when (setq viewers (mailcap-possible-viewers major-info minor))
             (setq info (mapcar (lambda (a)
                                  (cons (symbol-name (car a)) (cdr a)))
@@ -847,7 +865,7 @@ If NO-DECODE is non-nil, don't decode STRING."
        ((eq request 'all)
         passed)
        (t
-        ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
+        ;; MUST make a copy *sigh*, else we modify mailcap--computed-mime-data
         (setq viewer (copy-sequence viewer))
         (let ((view (assq 'viewer viewer))
               (test (assq 'test viewer)))
@@ -1057,7 +1075,7 @@ For instance, \"foo.png\" will result in \"image/png\"."
    (nconc
     (mapcar 'cdr mailcap-mime-extensions)
     (let (res type)
-      (dolist (data mailcap-mime-data)
+      (dolist (data mailcap--computed-mime-data)
         (dolist (info (cdr data))
           (setq type (cdr (assq 'type (cdr info))))
           (unless (string-match-p "\\*" type)
@@ -1117,7 +1135,7 @@ For instance, \"foo.png\" will result in \"image/png\"."
 
 (defun mailcap-view-mime (type)
   "View the data in the current buffer that has MIME type TYPE.
-`mailcap-mime-data' determines the method to use."
+`mailcap--computed-mime-data' determines the method to use."
   (let ((method (mailcap-mime-info type)))
     (if (stringp method)
        (shell-command-on-region (point-min) (point-max)