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.

diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el
index 414ba0fd852ad63225657c07edd973dc4844e7c6..a8ade01e818a24c9641e22d1b8d7ec9b9807de6c 100644 (file)
--- 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.