-;;; mailcap.el --- Functions for displaying MIME parts
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;;; mailcap.el --- MIME media types configuration
+;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
+;; 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.
;;; 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-and-compile
- (require 'cl))
+(eval-when-compile (require 'cl))
(require 'mail-parse)
+(require 'mm-util)
+
+(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))
(type . "application/x-x509-user-cert"))
("octet-stream"
(viewer . mailcap-save-binary-file)
- (type ."application/octet-stream"))
+ (non-viewer . t)
+ (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/x-tar"))
("x-latex"
(viewer . tex-mode)
(type . "application/tex"))
("zip"
(viewer . mailcap-save-binary-file)
+ (non-viewer . t)
(type . "application/zip")
("copiousoutput"))
+ ;; Prefer free viewers.
+ ("pdf"
+ (viewer . "gv -safer %s")
+ (type . "application/pdf")
+ (test . window-system)
+ ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
+ ("pdf"
+ (viewer . "xpdf %s")
+ (type . "application/pdf")
+ ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
+ (test . (eq window-system 'x)))
("pdf"
(viewer . "acroread %s")
- (type . "application/pdf"))
+ (type . "application/pdf")
+ ("print" . ,(concat "cat %s | acroread -toPostScript | "
+ mailcap-print-command))
+ (test . window-system))
+ ("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 %s")
+ (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)
- (test . (or (featurep 'nas-sound)
- (featurep 'native-sound)))
- (type . "audio/*"))
(".*"
(viewer . "showaudio")
(type . "audio/*")))
(viewer . mm-view-message)
(test . (and (featurep 'gnus)
(gnus-alive-p)))
- (type . "message/rfc-822"))
+ (type . "message/rfc822"))
("rfc-*822"
(viewer . vm-mode)
(test . (fboundp 'vm-mode))
- (type . "message/rfc-822"))
+ (type . "message/rfc822"))
("rfc-*822"
(viewer . w3-mode)
(test . (fboundp 'w3-mode))
- (type . "message/rfc-822"))
+ (type . "message/rfc822"))
("rfc-*822"
(viewer . view-mode)
- (test . (fboundp 'view-mode))
- (type . "message/rfc-822"))
- ("rfc-*822"
- (viewer . fundamental-mode)
- (type . "message/rfc-822")))
+ (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 window-system 'x))
+ ("needsx11"))
(".*"
- (viewer . "xv -perfect %s")
+ (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"
("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.
-
-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.")
-
-(defvar mailcap-download-directory nil
- "*Where downloaded files should go by default.")
-
-(defvar mailcap-temporary-directory (or (getenv "TMPDIR") "/tmp")
- "*Where temporary files go.")
+`funcall'ed, with the buffer as an argument.
+
+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.")
+
+(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-poor-system-types
+ '(ms-dos ms-windows windows-nt win32 w32 mswindows)
+ "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")
- ";")))
- (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)
+ (delete "" (split-string path path-separator))
+ 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))
- (while (not (eobp))
- (skip-chars-forward " \t\n")
+ (while (not (bobp))
+ (skip-chars-backward " \t\n")
+ (beginning-of-line)
(setq save-pos (point)
info nil)
- (skip-chars-forward "^/;")
+ (skip-chars-forward "^/; \t\n")
(downcase-region save-pos (point))
(setq major (buffer-substring save-pos (point)))
- (skip-chars-forward "/ \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^;")
- (downcase-region save-pos (point))
- (setq minor
- (cond
- ((eq ?* (or (char-after save-pos) 0)) ".*")
- ((= (point) save-pos) ".*")
- (t (buffer-substring save-pos (point)))))
- (skip-chars-forward "; \t\n")
+ (skip-chars-forward " \t")
+ (setq minor "")
+ (when (eq (char-after) ?/)
+ (forward-char)
+ (skip-chars-forward " \t")
+ (setq save-pos (point))
+ (skip-chars-forward "^; \t\n")
+ (downcase-region save-pos (point))
+ (setq minor
+ (cond
+ ((eq ?* (or (char-after save-pos) 0)) ".*")
+ ((= (point) save-pos) ".*")
+ (t (regexp-quote (buffer-substring save-pos (point)))))))
+ (skip-chars-forward " \t")
;;; Got the major/minor chunks, now for the viewers/etc
;;; The first item _must_ be a viewer, according to the
- ;;; RFC for mailcap files (#1343)
- (skip-chars-forward "; \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^;\n")
- (if (eq (or (char-after save-pos) 0) ?')
- (setq viewer (progn
- (narrow-to-region (1+ save-pos) (point))
- (goto-char (point-min))
- (prog1
- (read (current-buffer))
- (goto-char (point-max))
- (widen))))
- (setq viewer (buffer-substring save-pos (point))))
+ ;;; RFC for mailcap files (#1524)
+ (setq viewer "")
+ (when (eq (char-after) ?\;)
+ (forward-char)
+ (skip-chars-forward " \t")
+ (setq save-pos (point))
+ (skip-chars-forward "^;\n")
+ ;; skip \;
+ (while (eq (char-before) ?\\)
+ (backward-delete-char 1)
+ (forward-char)
+ (skip-chars-forward "^;\n"))
+ (if (eq (or (char-after save-pos) 0) ?')
+ (setq viewer (progn
+ (narrow-to-region (1+ save-pos) (point))
+ (goto-char (point-min))
+ (prog1
+ (read (current-buffer))
+ (goto-char (point-max))
+ (widen))))
+ (setq viewer (buffer-subst
projects / gnus / blobdiff