procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Tweak mailcap precedence so that Emacs values are heeded better

Browse source 
* 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.
This commit is contained in:
Lars Ingebrigtsen 2018-04-14 14:50:14 +02:00
parent e1c2ec5086
commit 0a299bd9a0
1 changed files with 38 additions and 18 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

56
lisp/net/mailcap.el
View file

@ -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.