Query for password, although there are no existing auth sources.
[gnus] / lisp / mailcap.el
index a70133d..5249285 100644 (file)
@@ -1,34 +1,62 @@
-;;; 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, 2004,
+;;   2005, 2006, 2007, 2008, 2009, 2010 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 'drums)
+  (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))
-      ("type" . "application/x-x509-ca-cert"))
+      (viewer . ssl-view-site-cert)
+      (test . (fboundp 'ssl-view-site-cert))
+      (type . "application/x-x509-ca-cert"))
      ("x-x509-user-cert"
-      ("viewer" . ssl-view-user-cert)
-      ("test" . (fboundp 'ssl-view-user-cert))
-      ("type" . "application/x-x509-user-cert"))
+      (viewer . ssl-view-user-cert)
+      (test . (fboundp 'ssl-view-user-cert))
+      (type . "application/x-x509-user-cert"))
      ("octet-stream"
-      ("viewer" . mailcap-save-binary-file)
-      ("type" ."application/octet-stream"))
+      (viewer . mailcap-save-binary-file)
+      (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"))
+      (viewer . "dvitty %s")
+      (test   . (not (getenv "DISPLAY")))
+      (type   . "application/dvi")
+      ("print" . "dvips -qRP %s"))
      ("emacs-lisp"
-      ("viewer" . mailcap-maybe-eval)
-      ("type"   . "application/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)
-      ("type"   . "application/x-tar"))
+      (viewer . mailcap-save-binary-file)
+      (non-viewer . t)
+      (type   . "application/x-tar"))
      ("x-latex"
-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/x-latex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/x-latex"))
      ("x-tex"
-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/x-tex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/x-tex"))
      ("latex"
-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/latex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/latex"))
      ("tex"
-      ("viewer" . tex-mode)
-      ("test"   . (fboundp 'tex-mode))
-      ("type"   . "application/tex"))
+      (viewer . tex-mode)
+      (test   . (fboundp 'tex-mode))
+      (type   . "application/tex"))
      ("texinfo"
-      ("viewer" . texinfo-mode)
-      ("test"   . (fboundp 'texinfo-mode))
-      ("type"   . "application/tex"))
+      (viewer . texinfo-mode)
+      (test   . (fboundp 'texinfo-mode))
+      (type   . "application/tex"))
      ("zip"
-      ("viewer" . mailcap-save-binary-file)
-      ("type"   . "application/zip")
+      (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 . "gv -safer %s")
+      (type . "application/postscript")
+      (test   . window-system)
+      ("print" . ,(concat mailcap-print-command " %s"))
+      ("needsx11"))
      ("postscript"
-      ("viewer" . "open %s")
-      ("type"   . "application/postscript")
-      ("test"   . (eq (mm-device-type) 'ns)))
-     ("postscript" 
-      ("viewer" . "ghostview %s")
-      ("type" . "application/postscript")
-      ("test"   . (eq (mm-device-type) 'x))
+      (viewer . "ghostview -dSAFER %s")
+      (type . "application/postscript")
+      (test   . (eq window-system 'x))
+      ("print" . ,(concat mailcap-print-command " %s"))
       ("needsx11"))
      ("postscript"
-      ("viewer" . "ps2ascii %s")
-      ("type" . "application/postscript")
-      ("test" . (not (getenv "DISPLAY")))
-      ("copiousoutput")))
+      (viewer . "ps2ascii %s")
+      (type . "application/postscript")
+      (test . (not (getenv "DISPLAY")))
+      ("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 . "maplay %s")
+      (type   . "audio/x-mpeg"))
      (".*"
-      ("viewer" . mm-play-sound-file)
-      ("test"   . (or (featurep 'nas-sound)
-                     (featurep 'native-sound)))
-      ("type"   . "audio/*"))
-     (".*"
-      ("viewer" . "showaudio")
-      ("type"   . "audio/*")))
+      (viewer . "showaudio")
+      (type   . "audio/*")))
     ("message"
      ("rfc-*822"
-      ("viewer" . vm-mode)
-      ("test"   . (fboundp 'vm-mode))
-      ("type"   . "message/rfc-822"))
+      (viewer . mm-view-message)
+      (test   . (and (featurep 'gnus)
+                    (gnus-alive-p)))
+      (type   . "message/rfc822"))
+     ("rfc-*822"
+      (viewer . vm-mode)
+      (test   . (fboundp 'vm-mode))
+      (type   . "message/rfc822"))
      ("rfc-*822"
-      ("viewer" . w3-mode)
-      ("test"   . (fboundp 'w3-mode))
-      ("type"   . "message/rfc-822"))
+      (viewer . w3-mode)
+      (test   . (fboundp 'w3-mode))
+      (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")))
+      (viewer . view-mode)
+      (type   . "message/rfc822")))
     ("image"
      ("x-xwd"
-      ("viewer"  . "xwud -in %s")
-      ("type"    . "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")
+      (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")
+      (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")
-      ("type" . "image/*")
-      ("test"   . (eq (mm-device-type) 'x))
+      (viewer . "ee %s")
+      (type . "image/*")
+      (test   . (eq window-system 'x))
       ("needsx11")))
     ("text"
      ("plain"
-      ("viewer"  . w3-mode)
-      ("test"    . (fboundp 'w3-mode))
-      ("type"    . "text/plain"))
+      (viewer  . w3-mode)
+      (test    . (fboundp 'w3-mode))
+      (type    . "text/plain"))
      ("plain"
-      ("viewer"  . view-mode)
-      ("test"    . (fboundp 'view-mode))
-      ("type"    . "text/plain"))
+      (viewer  . view-mode)
+      (test    . (fboundp 'view-mode))
+      (type    . "text/plain"))
      ("plain"
-      ("viewer"  . fundamental-mode)
-      ("type"    . "text/plain"))
+      (viewer  . fundamental-mode)
+      (type    . "text/plain"))
      ("enriched"
-      ("viewer" . enriched-decode-region)
-      ("test"   . (fboundp 'enriched-decode-region))
-      ("type"   . "text/enriched"))
+      (viewer . enriched-decode)
+      (test   . (fboundp 'enriched-decode))
+      (type   . "text/enriched"))
      ("html"
-      ("viewer" . mm-w3-prepare-buffer)
-      ("test"   . (fboundp 'w3-prepare-buffer))
-      ("type"   . "text/html")))
+      (viewer . mm-w3-prepare-buffer)
+      (test   . (fboundp 'w3-prepare-buffer))
+      (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))
+      (viewer . "mpeg_play %s")
+      (type   . "video/mpeg")
+      (test   . (eq window-system 'x))
       ("needsx11")))
     ("x-world"
      ("x-vrml"
-      ("viewer"  . "webspace -remote %s -URL %u")
-      ("type"    . "x-world/x-vrml")
+      (viewer  . "webspace -remote %s -URL %u")
+      (type    . "x-world/x-vrml")
       ("description"
        "VRML document")))
     ("archive"
      ("tar"
-      ("viewer" . tar-mode)
-      ("type" . "archive/tar")
-      ("test" . (fboundp 'tar-mode)))))
-     "*The mailcap structure is an assoc list of assoc lists.
+      (viewer . tar-mode)
+      (type . "archive/tar")
+      (test . (fboundp 'tar-mode)))))
+  "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)
 
@@ -217,67 +305,89 @@ Which looks like:
    (\"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