From: Lars Ingebrigtsen Date: Sun, 2 Aug 2020 07:04:31 +0000 (+0200) Subject: Try to fix mailcap parsing again to respect Emacs defaults X-Git-Tag: emacs-28.0.90~6869 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=eab636c7eb25c4e1cbfeb0fc48cc1274e1c55222;p=emacs.git 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. --- diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 5fe5b4d3a54..86f9d2bf07c 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -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)