Tweak mailcap precedence so that Emacs values are heeded better

* lisp/net/mailcap.el (mailcap-parse-mailcaps): Place entries from
system-wide mailcap files after the values that are distributed
with Emacs, and the ones from ~/.mailcap before.
(mailcap-parse-mailcap): Take an optional `after' parameter to
achieve that.
(mailcap-add-mailcap-entry): Ditto.

1 files changed, 38 insertions, 18 deletions

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 414ba0fd852..a8ade01e818 100644
--- a/lisp/net/mailcap.el
+++ b/lisp/net/mailcap.el
@@ -427,20 +427,32 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
      ((memq system-type mailcap-poor-system-types)
       (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
      (t (setq path
-              ;; This is per RFC 1524, specifically
-              ;; with /usr before /usr/local.
-              '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
-                "/usr/local/etc/mailcap"))))
-    (dolist (fname (reverse
-                    (if (stringp path)
-                        (split-string path path-separator t)
-                      path)))
-      (when (and (file-readable-p fname) (file-regular-p fname))
-        (mailcap-parse-mailcap fname)))
+              ;; This is per RFC 1524, specifically with /usr before
+              ;; /usr/local.
+              '("~/.mailcap"
+                ("/etc/mailcap" 'after)
+                ("/usr/etc/mailcap" 'after)
+                ("/usr/local/etc/mailcap" 'after)))))
+    ;; We read the entries from ~/.mailcap before the built-in values,
+    ;; but place the rest of then afterwards as fallback values.
+    (dolist (spec (reverse
+                        (if (stringp path)
+                            (split-string path path-separator t)
+                          path)))
+      (let ((afterp (and (consp spec)
+                         (cadr spec)))
+            (file-name (if (stringp spec)
+                           spec
+                         (car spec))))
+        (when (and (file-readable-p file-name)
+                   (file-regular-p file-name))
+          (mailcap-parse-mailcap file-name afterp))))
     (setq mailcap-parsed-p t)))
 
-(defun mailcap-parse-mailcap (fname)
-  "Parse out the mailcap file specified by FNAME."
+(defun mailcap-parse-mailcap (fname &optional after)
+  "Parse out the mailcap file specified by FNAME.
+If AFTER, place the entries from the file after the ones that are
+already there."
   (let (major                           ; The major mime type (image/audio/etc)
         minor                           ; The minor mime type (gif, basic, etc)
         save-pos                        ; Misc saved positions used in parsing
@@ -510,7 +522,7 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
                                                           "*" minor))))
                             (mailcap-parse-mailcap-extras save-pos (point))))
           (mailcap-mailcap-entry-passes-test info)
-          (mailcap-add-mailcap-entry major minor info))
+          (mailcap-add-mailcap-entry major minor info after))
         (beginning-of-line)))))
 
 (defun mailcap-parse-mailcap-extras (st nd)
@@ -693,7 +705,7 @@ to supply to the test."
            (push (list otest result) mailcap-viewer-test-cache)
            result))))
 
-(defun mailcap-add-mailcap-entry (major minor info)
+(defun mailcap-add-mailcap-entry (major minor info &optional after)
   (let ((old-major (assoc major mailcap-mime-data)))
     (if (null old-major)                ; New major area
         (push (cons major (list (cons minor info))) mailcap-mime-data)
@@ -701,15 +713,23 @@ to supply to the test."
         (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))))
+          (setcdr old-major
+                  (if after ; Or after, if specified.
+                      (nconc (cdr old-major)
+                             (list (cons minor info)))
+                    (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))
+          (unless after
+            (setcdr cur-minor info)))
          (t
-          (setcdr old-major (cons (cons minor info) (cdr old-major))))))
-      )))
+          (setcdr old-major
+                  (if after
+                      (nconc (cdr old-major) (list (cons minor info)))
+                    (setcdr old-major
+                            (cons (cons minor info) (cdr old-major)))))))))))
 
 (defun mailcap-add (type viewer &optional test)
   "Add VIEWER as a handler for TYPE.