diff options
Diffstat (limited to 'lisp/net/mailcap.el')
| -rw-r--r-- | lisp/net/mailcap.el | 146 |
1 files changed, 61 insertions, 85 deletions
diff --git a/lisp/net/mailcap.el b/lisp/net/mailcap.el index 89f6c91156b..b4b38707c89 100644 --- a/lisp/net/mailcap.el +++ b/lisp/net/mailcap.el @@ -1,4 +1,4 @@ -;;; mailcap.el --- MIME media types configuration +;;; mailcap.el --- MIME media types configuration -*- lexical-binding: t -*- ;; Copyright (C) 1998-2017 Free Software Foundation, Inc. @@ -19,7 +19,7 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: @@ -29,7 +29,6 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (autoload 'mail-header-parse-content-type "mail-parse") (defgroup mailcap nil @@ -70,11 +69,10 @@ (defun mailcap--set-user-mime-data (sym val) (let (res) - (dolist (entry val) - (push `((viewer . ,(car entry)) - (type . ,(cadr entry)) - ,@(when (cl-caddr entry) - `((test . ,(cl-caddr entry))))) + (pcase-dolist (`(,viewer ,type ,test) val) + (push `((viewer . ,viewer) + (type . ,type) + ,@(when test `((test . ,test)))) res)) (set-default sym (nreverse res)))) @@ -121,12 +119,6 @@ is consulted." (viewer . "gnumeric %s") (test . (getenv "DISPLAY")) (type . "application/vnd.ms-excel")) - ("x-x509-ca-cert" - (viewer . ssl-view-site-cert) - (type . "application/x-x509-ca-cert")) - ("x-x509-user-cert" - (viewer . ssl-view-user-cert) - (type . "application/x-x509-user-cert")) ("octet-stream" (viewer . mailcap-save-binary-file) (non-viewer . t) @@ -175,11 +167,11 @@ is consulted." ("pdf" (viewer . pdf-view-mode) (type . "application/pdf") - (test . (eq window-system 'x))) + (test . window-system)) ("pdf" (viewer . doc-view-mode) (type . "application/pdf") - (test . (eq window-system 'x))) + (test . window-system)) ("pdf" (viewer . "gv -safer %s") (type . "application/pdf") @@ -331,7 +323,7 @@ means the viewer is always valid. If it is a Lisp function, it is called with a list of items from any extra fields from the Content-Type header as argument to return a boolean value for the validity. Otherwise, if it is a non-function Lisp symbol or list -whose car is a symbol, it is `eval'led to yield the validity. If it +whose car is a symbol, it is `eval'uated to yield the validity. If it 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) @@ -434,9 +426,8 @@ MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus (if (stringp path) (split-string path path-separator t) path))) - (if (and (file-readable-p fname) - (file-regular-p fname)) - (mailcap-parse-mailcap fname))) + (when (and (file-readable-p fname) (file-regular-p fname)) + (mailcap-parse-mailcap fname))) (setq mailcap-parsed-p t))) (defun mailcap-parse-mailcap (fname) @@ -597,13 +588,12 @@ the test clause will be unchanged." "Return a list of possible viewers from MAJOR for minor type MINOR." (let ((exact '()) (wildcard '())) - (while major + (pcase-dolist (`(,type . ,attrs) major) (cond - ((equal (car (car major)) minor) - (push (cdr (car major)) exact)) - ((and minor (string-match (concat "^" (car (car major)) "$") minor)) - (push (cdr (car major)) wildcard))) - (setq major (cdr major))) + ((equal type minor) + (push attrs exact)) + ((and minor (string-match (concat "^" type "$") minor)) + (push attrs wildcard)))) (nconc exact wildcard))) (defun mailcap-unescape-mime-test (test type-info) @@ -801,10 +791,9 @@ If NO-DECODE is non-nil, don't decode STRING." (setq info (mapcar (lambda (a) (cons (symbol-name (car a)) (cdr a))) (cdr ctl))) - (while viewers - (if (mailcap-viewer-passes-test (car viewers) info) - (push (car viewers) passed)) - (setq viewers (cdr viewers))) + (dolist (entry viewers) + (when (mailcap-viewer-passes-test entry info) + (push entry passed))) (setq passed (sort passed 'mailcap-viewer-lessp)) (setq viewer (car passed)))) (when (and (stringp (cdr (assq 'viewer viewer))) @@ -971,8 +960,8 @@ If FORCE, re-parse even if already parsed." (dolist (fname (reverse (if (stringp path) (split-string path path-separator t) path))) - (if (and (file-readable-p fname)) - (mailcap-parse-mimetype-file fname))) + (when (file-readable-p fname) + (mailcap-parse-mimetype-file fname))) (setq mailcap-mimetypes-parsed-p t))) (defun mailcap-parse-mimetype-file (fname) @@ -980,7 +969,7 @@ If FORCE, re-parse even if already parsed." (let (type ; The MIME type for this line extns ; The extensions for this line save-pos ; Misc. saved buffer positions - ) + save-extn) (with-temp-buffer (insert-file-contents fname) (mailcap-replace-regexp "#.*" "") @@ -1000,15 +989,13 @@ If FORCE, re-parse even if already parsed." (skip-chars-forward " \t") (setq save-pos (point)) (skip-chars-forward "^ \t\n") - (setq extns (cons (buffer-substring save-pos (point)) extns))) - (while extns - (setq mailcap-mime-extensions - (cons - (cons (if (= (string-to-char (car extns)) ?.) - (car extns) - (concat "." (car extns))) type) - mailcap-mime-extensions) - extns (cdr extns))))))) + (setq save-extn (buffer-substring save-pos (point))) + (push (cons (if (= (string-to-char save-extn) ?.) + save-extn (concat "." save-extn)) + type) + extns)) + (setq mailcap-mime-extensions (append extns mailcap-mime-extensions) + extns nil))))) (defun mailcap-extension-to-mime (extn) "Return the MIME content type of the file extensions EXTN." @@ -1018,29 +1005,19 @@ If FORCE, re-parse even if already parsed." (setq extn (concat "." extn))) (cdr (assoc (downcase extn) mailcap-mime-extensions))) -;; Unused? -(defalias 'mailcap-command-p 'executable-find) - (defun mailcap-mime-types () "Return a list of MIME media types." (mailcap-parse-mimetypes) (delete-dups (nconc (mapcar 'cdr mailcap-mime-extensions) - (apply - 'nconc - (mapcar - (lambda (l) - (delq nil - (mapcar - (lambda (m) - (let ((type (cdr (assq 'type (cdr m))))) - (if (equal (cadr (split-string type "/")) - "*") - nil - type))) - (cdr l)))) - mailcap-mime-data))))) + (let (res type) + (dolist (data mailcap-mime-data) + (dolist (info (cdr data)) + (setq type (cdr (assq 'type (cdr info)))) + (unless (string-match-p "\\*" type) + (push type res)))) + (nreverse res))))) ;;; ;;; Useful supplementary functions @@ -1067,32 +1044,31 @@ If FORCE, re-parse even if already parsed." ;; Intersection of mime-infos from different mime-types; ;; or just the first MIME info for a single MIME type (if (cdr all-mime-info) - (delq nil (mapcar (lambda (mi1) - (unless (memq nil (mapcar - (lambda (mi2) - (member mi1 mi2)) - (cdr all-mime-info))) - mi1)) - (car all-mime-info))) - (car all-mime-info))) - (commands - ;; Command strings from `viewer' field of the MIME info - (delete-dups - (delq nil (mapcar - (lambda (mime-info) - (let ((command (cdr (assoc 'viewer mime-info)))) - (if (stringp command) - (replace-regexp-in-string - ;; Replace mailcap's `%s' placeholder - ;; with dired's `?' placeholder - "%s" "?" - (replace-regexp-in-string - ;; Remove the final filename placeholder - "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" - command nil t) - nil t)))) - common-mime-info))))) - commands)) + (let (res) + (dolist (mi1 (car all-mime-info)) + (dolist (mi2 (cdr all-mime-info)) + (when (member mi1 mi2) + (push mi1 res)))) + (nreverse res)) + (car all-mime-info)))) + ;; Command strings from `viewer' field of the MIME info + (delete-dups + (let (res command) + (dolist (mime-info common-mime-info) + (setq command (cdr (assq 'viewer mime-info))) + (when (stringp command) + (push + (replace-regexp-in-string + ;; Replace mailcap's `%s' placeholder + ;; with dired's `?' placeholder + "%s" "?" + (replace-regexp-in-string + ;; Remove the final filename placeholder + "[ \t\n]*\\('\\)?%s\\1?[ \t\n]*\\'" "" + command nil t) + nil t) + res))) + (nreverse res))))) (defun mailcap-view-mime (type) "View the data in the current buffer that has MIME type TYPE. |