-;;; mailcap.el --- Functions for displaying MIME parts
-;; Copyright (C) 1998,99 Free Software Foundation, Inc.
+;;; mailcap.el --- MIME media types configuration
+
+;; Copyright (C) 1998-2012 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
+;; Keywords: news, mail, multimedia
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
+;; Provides configuration of MIME media types from directly from Lisp
+;; and via the usual mailcap mechanism (RFC 1524). Deals with
+;; mime.types similarly.
+
;;; Code:
+(eval-when-compile (require 'cl))
+(autoload 'mail-header-parse-content-type "mail-parse")
+
+;; `mm-delete-duplicates' is an alias for `delete-dups' in Emacs 22.
+(defalias 'mailcap-delete-duplicates
+ (if (fboundp 'delete-dups)
+ 'delete-dups
+ (autoload 'mm-delete-duplicates "mm-util")
+ 'mm-delete-duplicates))
+
+;; `mailcap-replace-in-string' is an alias like `gnus-replace-in-string'.
(eval-and-compile
- (require 'cl))
-(require 'mail-parse)
+ (cond
+ ((fboundp 'replace-regexp-in-string)
+ (defun mailcap-replace-in-string (string regexp newtext &optional literal)
+ "Replace all matches for REGEXP with NEWTEXT in STRING.
+If LITERAL is non-nil, insert NEWTEXT literally. Return a new
+string containing the replacements.
+This is a compatibility function for different Emacsen."
+ (replace-regexp-in-string regexp newtext string nil literal)))
+ ((fboundp 'replace-in-string)
+ (defalias 'mailcap-replace-in-string 'replace-in-string))))
+
+(defgroup mailcap nil
+ "Definition of viewers for MIME types."
+ :version "21.1"
+ :group 'mime)
(defvar mailcap-parse-args-syntax-table
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
(modify-syntax-entry ?{ "(" table)
(modify-syntax-entry ?} ")" table)
table)
- "A syntax table for parsing sgml attributes.")
+ "A syntax table for parsing SGML attributes.")
+
+(eval-and-compile
+ (when (featurep 'xemacs)
+ (condition-case nil
+ (require 'lpr)
+ (error nil))))
+
+(defvar mailcap-print-command
+ (mapconcat 'identity
+ (cons (if (boundp 'lpr-command)
+ lpr-command
+ "lpr")
+ (when (boundp 'lpr-switches)
+ (if (stringp lpr-switches)
+ (list lpr-switches)
+ lpr-switches)))
+ " ")
+ "Shell command (including switches) used to print PostScript files.")
+;; Postpone using defcustom for this as it's so big and we essentially
+;; have to have two copies of the data around then. Perhaps just
+;; customize the Lisp viewers and rely on the normal configuration
+;; files for the rest? -- fx
(defvar mailcap-mime-data
- '(("application"
+ `(("application"
+ ("vnd\\.ms-excel"
+ (viewer . "gnumeric %s")
+ (test . (getenv "DISPLAY"))
+ (type . "application/vnd.ms-excel"))
("x-x509-ca-cert"
(viewer . ssl-view-site-cert)
(test . (fboundp 'ssl-view-site-cert))
("octet-stream"
(viewer . mailcap-save-binary-file)
(non-viewer . t)
- (type ."application/octet-stream"))
+ (type . "application/octet-stream"))
("dvi"
- (viewer . "open %s")
- (type . "application/dvi")
- (test . (eq (mm-device-type) 'ns)))
- ("dvi"
- (viewer . "xdvi %s")
- (test . (eq (mm-device-type) 'x))
+ (viewer . "xdvi -safer %s")
+ (test . (eq window-system 'x))
("needsx11")
- (type . "application/dvi"))
+ (type . "application/dvi")
+ ("print" . "dvips -qRP %s"))
("dvi"
(viewer . "dvitty %s")
(test . (not (getenv "DISPLAY")))
- (type . "application/dvi"))
+ (type . "application/dvi")
+ ("print" . "dvips -qRP %s"))
("emacs-lisp"
(viewer . mailcap-maybe-eval)
(type . "application/emacs-lisp"))
+ ("x-emacs-lisp"
+ (viewer . mailcap-maybe-eval)
+ (type . "application/x-emacs-lisp"))
("x-tar"
(viewer . mailcap-save-binary-file)
(non-viewer . t)
(type . "application/zip")
("copiousoutput"))
("pdf"
- (viewer . "acroread %s")
- (type . "application/pdf"))
+ (viewer . "gv -safer %s")
+ (type . "application/pdf")
+ (test . window-system)
+ ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
+ ("pdf"
+ (viewer . "gpdf %s")
+ (type . "application/pdf")
+ ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+ (test . (eq window-system 'x)))
+ ("pdf"
+ (viewer . "xpdf %s")
+ (type . "application/pdf")
+ ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+ (test . (eq window-system 'x)))
+ ("pdf"
+ (viewer . ,(concat "pdftotext %s -"))
+ (type . "application/pdf")
+ ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+ ("copiousoutput"))
("postscript"
- (viewer . "open %s")
- (type . "application/postscript")
- (test . (eq (mm-device-type) 'ns)))
+ (viewer . "gv -safer %s")
+ (type . "application/postscript")
+ (test . window-system)
+ ("print" . ,(concat mailcap-print-command " %s"))
+ ("needsx11"))
("postscript"
(viewer . "ghostview -dSAFER %s")
(type . "application/postscript")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
+ ("print" . ,(concat mailcap-print-command " %s"))
("needsx11"))
("postscript"
(viewer . "ps2ascii %s")
(type . "application/postscript")
(test . (not (getenv "DISPLAY")))
- ("copiousoutput")))
+ ("print" . ,(concat mailcap-print-command " %s"))
+ ("copiousoutput"))
+ ("sieve"
+ (viewer . sieve-mode)
+ (test . (fboundp 'sieve-mode))
+ (type . "application/sieve"))
+ ("pgp-keys"
+ (viewer . "gpg --import --interactive --verbose")
+ (type . "application/pgp-keys")
+ ("needsterminal")))
("audio"
("x-mpeg"
(viewer . "maplay %s")
(type . "audio/x-mpeg"))
- (".*"
- (viewer . mailcap-save-binary-file)
- (non-viewer . t)
- (test . (or (featurep 'nas-sound)
- (featurep 'native-sound)))
- (type . "audio/*"))
(".*"
(viewer . "showaudio")
(type . "audio/*")))
(type . "message/rfc822"))
("rfc-*822"
(viewer . view-mode)
- (test . (fboundp 'view-mode))
- (type . "message/rfc822"))
- ("rfc-*822"
- (viewer . fundamental-mode)
(type . "message/rfc822")))
("image"
("x-xwd"
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
("x11-dump"
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
("windowdump"
(viewer . "xwud -in %s")
(type . "image/x-xwd")
("compose" . "xwd -frame > %s")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
- (".*"
- (viewer . "aopen %s")
- (type . "image/*")
- (test . (eq (mm-device-type) 'ns)))
(".*"
(viewer . "display %s")
(type . "image/*")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11"))
(".*"
(viewer . "ee %s")
(type . "image/*")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11")))
("text"
("plain"
(viewer . fundamental-mode)
(type . "text/plain"))
("enriched"
- (viewer . enriched-decode-region)
+ (viewer . enriched-decode)
(test . (fboundp 'enriched-decode))
(type . "text/enriched"))
("html"
(viewer . mm-w3-prepare-buffer)
(test . (fboundp 'w3-prepare-buffer))
- (type . "text/html")))
+ (type . "text/html"))
+ ("dns"
+ (viewer . dns-mode)
+ (test . (fboundp 'dns-mode))
+ (type . "text/dns")))
("video"
("mpeg"
(viewer . "mpeg_play %s")
(type . "video/mpeg")
- (test . (eq (mm-device-type) 'x))
+ (test . (eq window-system 'x))
("needsx11")))
("x-world"
("x-vrml"
(viewer . tar-mode)
(type . "archive/tar")
(test . (fboundp 'tar-mode)))))
- "The mailcap structure is an assoc list of assoc lists.
+ "The mailcap structure is an assoc list of assoc lists.
1st assoc list is keyed on the major content-type
2nd assoc list is keyed on the minor content-type (which can be a regexp)
(\"plain\" . <info>)))
Where <info> is another assoc list of the various information
-related to the mailcap RFC. This is keyed on the lowercase
+related to the mailcap RFC 1524. This is keyed on the lowercase
attribute name (viewer, test, etc). This looks like:
- ((viewer . viewerinfo)
- (test . testinfo)
- (xxxx . \"string\"))
+ ((viewer . VIEWERINFO)
+ (test . TESTINFO)
+ (xxxx . \"STRING\")
+ FLAG)
-Where viewerinfo specifies how the content-type is viewed. Can be
+Where VIEWERINFO specifies how the content-type is viewed. Can be
a string, in which case it is run through a shell, with
appropriate parameters, or a symbol, in which case the symbol is
-funcall'd, with the buffer as an argument.
+`funcall'ed, with the buffer as an argument.
-testinfo is a list of strings, or nil. If nil, it means the
-viewer specified is always valid. If it is a list of strings,
-these are used to determine whether a viewer passes the 'test' or
-not.")
+TESTINFO is a test for the viewer's applicability, or nil. If nil, it
+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
+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-download-directory nil
- "*Where downloaded files should go by default.")
+(defcustom mailcap-download-directory nil
+ "*Directory to which `mailcap-save-binary-file' downloads files by default.
+nil means your home directory."
+ :type '(choice (const :tag "Home directory" nil)
+ directory)
+ :group 'mailcap)
-(defvar mailcap-temporary-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/"))
- "*Where temporary files go.")
+(defvar mailcap-poor-system-types
+ '(ms-dos windows-nt)
+ "Systems that don't have a Unix-like directory hierarchy.")
;;;
;;; Utility functions
;;;
-(defun mailcap-generate-unique-filename (&optional fmt)
- "Generate a unique filename in mailcap-temporary-directory"
- (if (not fmt)
- (let ((base (format "mailcap-tmp.%d" (user-real-uid)))
- (fname "")
- (x 0))
- (setq fname (format "%s%d" base x))
- (while (file-exists-p
- (expand-file-name fname mailcap-temporary-directory))
- (setq x (1+ x)
- fname (concat base (int-to-string x))))
- (expand-file-name fname mailcap-temporary-directory))
- (let ((base (concat "mm" (int-to-string (user-real-uid))))
- (fname "")
- (x 0))
- (setq fname (format fmt (concat base (int-to-string x))))
- (while (file-exists-p
- (expand-file-name fname mailcap-temporary-directory))
- (setq x (1+ x)
- fname (format fmt (concat base (int-to-string x)))))
- (expand-file-name fname mailcap-temporary-directory))))
-
(defun mailcap-save-binary-file ()
(goto-char (point-min))
(unwind-protect
(write-region (point-min) (point-max) file))
(kill-buffer (current-buffer))))
+(defvar mailcap-maybe-eval-warning
+ "*** WARNING ***
+
+This MIME part contains untrusted and possibly harmful content.
+If you evaluate the Emacs Lisp code contained in it, a lot of nasty
+things can happen. Please examine the code very carefully before you
+instruct Emacs to evaluate it. You can browse the buffer containing
+the code using \\[scroll-other-window].
+
+If you are unsure what to do, please answer \"no\"."
+ "Text of warning message displayed by `mailcap-maybe-eval'.
+Make sure that this text consists only of few text lines. Otherwise,
+Gnus might fail to display all of it.")
+
(defun mailcap-maybe-eval ()
- "Maybe evaluate a buffer of emacs lisp code"
- (if (yes-or-no-p "This is emacs-lisp code, evaluate it? ")
- (eval-buffer (current-buffer))
- (emacs-lisp-mode)))
+ "Maybe evaluate a buffer of Emacs Lisp code."
+ (let ((lisp-buffer (current-buffer)))
+ (goto-char (point-min))
+ (when
+ (save-window-excursion
+ (delete-other-windows)
+ (let ((buffer (get-buffer-create (generate-new-buffer-name
+ "*Warning*"))))
+ (unwind-protect
+ (with-current-buffer buffer
+ (insert (substitute-command-keys
+ mailcap-maybe-eval-warning))
+ (goto-char (point-min))
+ (display-buffer buffer)
+ (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? "))
+ (kill-buffer buffer))))
+ (eval-buffer (current-buffer)))
+ (when (buffer-live-p lisp-buffer)
+ (with-current-buffer lisp-buffer
+ (emacs-lisp-mode)))))
+
;;;
;;; The mailcap parser
(defvar mailcap-parsed-p nil)
(defun mailcap-parse-mailcaps (&optional path force)
- "Parse out all the mailcaps specified in a unix-style path string PATH.
-If FORCE, re-parse even if already parsed."
+ "Parse out all the mailcaps specified in a path string PATH.
+Components of PATH are separated by the `path-separator' character
+appropriate for this system. If FORCE, re-parse even if already
+parsed. If PATH is omitted, use the value of environment variable
+MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
+/usr/local/etc/mailcap."
(interactive (list nil t))
(when (or (not mailcap-parsed-p)
force)
(cond
(path nil)
((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
- ((memq system-type '(ms-dos ms-windows windows-nt))
- (setq path (mapconcat 'expand-file-name
- '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap")
- ";")))
- (t (setq path (mapconcat 'expand-file-name
- '("~/.mailcap"
- "/etc/mailcap:/usr/etc/mailcap"
- "/usr/local/etc/mailcap") ":"))))
+ ((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"))))
(let ((fnames (reverse
- (split-string
- path (if (memq system-type
- '(ms-dos ms-windows windows-nt))
- ";"
- ":"))))
+ (if (stringp path)
+ (split-string path path-separator t)
+ path)))
fname)
(while fnames
(setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname)
- (file-regular-p fname))
- (mailcap-parse-mailcap (car fnames)))
+ (if (and (file-readable-p fname)
+ (file-regular-p fname))
+ (mailcap-parse-mailcap fname))
(setq fnames (cdr fnames))))
- (setq mailcap-parsed-p t)))
+ (setq mailcap-parsed-p t)))
(defun mailcap-parse-mailcap (fname)
- ;; Parse out the mailcap file specified by FNAME
+ "Parse out the mailcap file specified by FNAME."
(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
(insert-file-contents fname)
(set-syntax-table mailcap-parse-args-syntax-table)
(mailcap-replace-regexp "#.*" "") ; Remove all comments
+ (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces
(mailcap-replace-regexp "\n+" "\n") ; And blank lines
- (mailcap-replace-regexp "\\\\[ \t\n]+" " ") ; And collapse spaces
- (mailcap-replace-regexp (concat (regexp-quote "\\") "[ \t]*\n") "")
(goto-char (point-max))
(skip-chars-backward " \t\n")
(delete-region (point) (point-max))
- (goto-char (point-min))
-
projects / gnus / blobdiff