From a5a967b43dd2810635d7a06ea70510c4a8e5c10f Mon Sep 17 00:00:00 2001 From: Lars Ingebrigtsen Date: Mon, 7 Oct 2019 05:00:16 +0200 Subject: [PATCH] Make mailcap-prefer-mailcap-viewers work as documented * lisp/emacs-lisp/seq.el (seq-find): Autoload. * lisp/net/mailcap.el (mailcap-parse-mailcaps): Note where all the entries come from so that we can later distinguish between user values and system values (bug#36771). (mailcap-parse-mailcap): Take a source parameter. (mailcap-possible-viewers): No need to sort wildcards/exact matches; these are later sorted anyway. (mailcap-add-mailcap-entry): Remove `after' parameter. (mailcap-mime-info): Make mailcap-prefer-mailcap-viewers work as documented. --- lisp/emacs-lisp/seq.el | 1 + lisp/net/mailcap.el | 95 ++++++++++++++++++++++-------------------- 2 files changed, 50 insertions(+), 46 deletions(-) diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 3413cd1513c..f001dceecec 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -334,6 +334,7 @@ If so, return the first non-nil value returned by PRED." (throw 'seq--break result)))) nil)) +;;;###autoload (cl-defgeneric seq-find (pred sequence &optional default) "Return the first element for which (PRED element) is non-nil in SEQUENCE. If no element is found, return DEFAULT. diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index eb4312ef3b5..600ed86f274 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -421,38 +421,41 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (interactive (list nil t)) (when (or (not mailcap-parsed-p) force) + ;; Clear out all old data. + (setq mailcap-mime-data nil) (cond (path nil) - ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS"))) + ((getenv "MAILCAPS") + (setq path (getenv "MAILCAPS"))) ((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" '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. + (setq path '(("~/.mailcap" user) + ("~/mail.cap" user) + ("~/etc/mail.cap" user)))) + (t + (setq path + ;; This is per RFC 1524, specifically with /usr before + ;; /usr/local. + '(("~/.mailcap" user) + ("/etc/mailcap" system) + ("/usr/etc/mailcap" system) + ("/usr/local/etc/mailcap" system))))) + ;; The ~/.mailcap entries will end up first in the resulting data. (dolist (spec (reverse - (if (stringp path) - (split-string path path-separator t) - path))) - (let ((afterp (and (consp spec) - (cadr spec))) + (if (stringp path) + (split-string path path-separator t) + path))) + (let ((source (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)))) + (mailcap-parse-mailcap file-name source)))) (setq mailcap-parsed-p t))) -(defun mailcap-parse-mailcap (fname &optional after) +(defun mailcap-parse-mailcap (fname &optional source) "Parse out the mailcap file specified by FNAME. -If AFTER, place the entries from the file after the ones that are -already there." +If SOURCE, mark the entry with this as the source." (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 @@ -522,7 +525,10 @@ already there." "*" minor)))) (mailcap-parse-mailcap-extras save-pos (point)))) (mailcap-mailcap-entry-passes-test info) - (mailcap-add-mailcap-entry major minor info after)) + ;; Record where the data came from. + (when source + (setq info (nconc info (list (cons 'source source))))) + (mailcap-add-mailcap-entry major minor info)) (beginning-of-line))))) (defun mailcap-parse-mailcap-extras (st nd) @@ -607,15 +613,13 @@ the test clause will be unchanged." (defun mailcap-possible-viewers (major minor) "Return a list of possible viewers from MAJOR for minor type MINOR." - (let ((exact '()) - (wildcard '())) + (let ((result nil)) (pcase-dolist (`(,type . ,attrs) major) - (cond - ((equal type minor) - (push attrs exact)) - ((and minor (string-match (concat "^" type "$") minor)) - (push attrs wildcard)))) - (nconc exact wildcard))) + (when (or (equal type minor) + (and minor + (string-match (concat "^" type "$") minor))) + (push attrs result))) + (nreverse result))) (defun mailcap-unescape-mime-test (test type-info) (let (save-pos save-chr subst) @@ -705,7 +709,7 @@ to supply to the test." (push (list otest result) mailcap-viewer-test-cache) result)))) -(defun mailcap-add-mailcap-entry (major minor info &optional after) +(defun mailcap-add-mailcap-entry (major minor info) (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) @@ -714,22 +718,16 @@ to supply to the test." ((or (null cur-minor) ; New minor area, or (assq 'test info)) ; Has a test, insert at beginning (setcdr old-major - (if after ; Or after, if specified. - (nconc (cdr old-major) - (list (cons minor info))) - (cons (cons minor info) (cdr old-major))))) + (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))) - (unless after - (setcdr cur-minor info))) + (setcdr cur-minor info)) (t (setcdr old-major - (if after - (nconc (cdr old-major) (list (cons minor info))) - (setcdr old-major - (cons (cons minor info) (cdr old-major))))))))))) + (setcdr old-major + (cons (cons minor info) (cdr old-major)))))))))) (defun mailcap-add (type viewer &optional test) "Add VIEWER as a handler for TYPE. @@ -812,7 +810,7 @@ If NO-DECODE is non-nil, don't decode STRING." (setq passed (list viewer)) ;; None found, so heuristically select some applicable viewer ;; from `mailcap-mime-data'. - (mailcap-parse-mailcaps) + (mailcap-parse-mailcaps nil t) (setq major (split-string (car ctl) "/")) (setq minor (cadr major) major (car major)) @@ -824,11 +822,16 @@ If NO-DECODE is non-nil, don't decode STRING." (dolist (entry viewers) (when (mailcap-viewer-passes-test entry info) (push entry passed))) - ;; The data is in "logical" order; entries from ~/.mailcap - ;; are first, so we don't need to do any sorting if the - ;; user wants ~/.mailcap to be preferred. - (unless mailcap-prefer-mailcap-viewers - (setq passed (sort passed 'mailcap-viewer-lessp))) + (setq passed (sort (nreverse passed) 'mailcap-viewer-lessp)) + ;; When we want to prefer entries from the user's + ;; ~/.mailcap file, then we filter out the system entries + ;; and see whether we have anything left. + (when mailcap-prefer-mailcap-viewers + (when-let ((user-entry + (seq-find (lambda (elem) + (eq (cdr (assq 'source elem)) 'user)) + passed))) + (setq passed (list user-entry)))) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) passed) -- 2.39.5