From 0a299bd9a0165576afdc7a2ff80de2f7604d49c9 Mon Sep 17 00:00:00 2001
From: Lars Ingebrigtsen <larsi@gnus.org>
Date: Sat, 14 Apr 2018 14:50:14 +0200
Subject: [PATCH] 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.
---
lisp/net/mailcap.el | 56 ++++++++++++++++++++++++++++++---------------
1 file 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.
--
2.39.5