Commit eab636c7 authored by Lars Ingebrigtsen's avatar Lars Ingebrigtsen

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.
parent 8f181124
Pipeline #6196 failed with stage
in 58 minutes and 48 seconds
......@@ -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)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment