/[emacs]/emacs/lisp/gnus/mailcap.el
ViewVC logotype

Diff of /emacs/lisp/gnus/mailcap.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9 by rms, Wed Apr 21 19:15:28 2004 UTC revision 1.9.2.1 by schwab, Thu Jul 22 16:45:49 2004 UTC
# Line 1  Line 1 
1  ;;; mailcap.el --- MIME media types configuration  ;;; mailcap.el --- MIME media types configuration
2  ;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.  ;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003
3    ;;       Free Software Foundation, Inc.
4    
5  ;; Author: William M. Perry <wmperry@aventail.com>  ;; Author: William M. Perry <wmperry@aventail.com>
6  ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>  ;;      Lars Magne Ingebrigtsen <larsi@gnus.org>
# Line 46  Line 47 
47      (modify-syntax-entry ?{ "(" table)      (modify-syntax-entry ?{ "(" table)
48      (modify-syntax-entry ?} ")" table)      (modify-syntax-entry ?} ")" table)
49      table)      table)
50    "A syntax table for parsing sgml attributes.")    "A syntax table for parsing SGML attributes.")
51    
52    (eval-and-compile
53      (when (featurep 'xemacs)
54        (condition-case nil
55            (require 'lpr)
56          (error nil))))
57    
58    (defvar mailcap-print-command
59      (mapconcat 'identity
60                 (cons (if (boundp 'lpr-command)
61                           lpr-command
62                         "lpr")
63                       (when (boundp 'lpr-switches)
64                         (if (stringp lpr-switches)
65                             (list lpr-switches)
66                           lpr-switches)))
67                 " ")
68      "Shell command (including switches) used to print Postscript files.")
69    
70  ;; Postpone using defcustom for this as it's so big and we essentially  ;; Postpone using defcustom for this as it's so big and we essentially
71  ;; have to have two copies of the data around then.  Perhaps just  ;; have to have two copies of the data around then.  Perhaps just
72  ;; customize the Lisp viewers and rely on the normal configuration  ;; customize the Lisp viewers and rely on the normal configuration
73  ;; files for the rest?  -- fx  ;; files for the rest?  -- fx
74  (defvar mailcap-mime-data  (defvar mailcap-mime-data
75    '(("application"    `(("application"
76         ("vnd.ms-excel"
77          (viewer . "gnumeric %s")
78          (test   . (getenv "DISPLAY"))
79          (type . "application/vnd.ms-excel"))
80       ("x-x509-ca-cert"       ("x-x509-ca-cert"
81        (viewer . ssl-view-site-cert)        (viewer . ssl-view-site-cert)
82        (test . (fboundp 'ssl-view-site-cert))        (test . (fboundp 'ssl-view-site-cert))
# Line 66  Line 89 
89        (viewer . mailcap-save-binary-file)        (viewer . mailcap-save-binary-file)
90        (non-viewer . t)        (non-viewer . t)
91        (type . "application/octet-stream"))        (type . "application/octet-stream"))
 ;;; XEmacs says `ns' device-type not implemented.  
 ;;      ("dvi"  
 ;;       (viewer . "open %s")  
 ;;       (type   . "application/dvi")  
 ;;       (test   . (eq (mm-device-type) 'ns)))  
92       ("dvi"       ("dvi"
93        (viewer . "xdvi %s")        (viewer . "xdvi -safer %s")
94        (test   . (eq (mm-device-type) 'x))        (test   . (eq window-system 'x))
95        ("needsx11")        ("needsx11")
96        (type   . "application/dvi"))        (type   . "application/dvi")
97          ("print" . "dvips -qRP %s"))
98       ("dvi"       ("dvi"
99        (viewer . "dvitty %s")        (viewer . "dvitty %s")
100        (test   . (not (getenv "DISPLAY")))        (test   . (not (getenv "DISPLAY")))
101        (type   . "application/dvi"))        (type   . "application/dvi")
102          ("print" . "dvips -qRP %s"))
103       ("emacs-lisp"       ("emacs-lisp"
104        (viewer . mailcap-maybe-eval)        (viewer . mailcap-maybe-eval)
105        (type   . "application/emacs-lisp"))        (type   . "application/emacs-lisp"))
106         ("x-emacs-lisp"
107          (viewer . mailcap-maybe-eval)
108          (type   . "application/x-emacs-lisp"))
109       ("x-tar"       ("x-tar"
110        (viewer . mailcap-save-binary-file)        (viewer . mailcap-save-binary-file)
111        (non-viewer . t)        (non-viewer . t)
# Line 114  Line 137 
137        ("copiousoutput"))        ("copiousoutput"))
138       ;; Prefer free viewers.       ;; Prefer free viewers.
139       ("pdf"       ("pdf"
140        (viewer . "gv %s")        (viewer . "gv -safer %s")
141        (type . "application/pdf")        (type . "application/pdf")
142        (test . window-system))        (test . window-system)
143          ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
144       ("pdf"       ("pdf"
145        (viewer . "xpdf %s")        (viewer . "xpdf %s")
146        (type . "application/pdf")        (type . "application/pdf")
147        (test . (eq (mm-device-type) 'x)))        ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
148          (test . (eq window-system 'x)))
149       ("pdf"       ("pdf"
150        (viewer . "acroread %s")        (viewer . "acroread %s")
151        (type   . "application/pdf"))        (type   . "application/pdf")
152  ;;; XEmacs says `ns' device-type not implemented.        ("print" . ,(concat "cat %s | acroread -toPostScript | "
153  ;;      ("postscript"                            mailcap-print-command))
154  ;;       (viewer . "open %s")        (test . window-system))
155  ;;       (type   . "application/postscript")       ("pdf"
156  ;;       (test   . (eq (mm-device-type) 'ns)))        (viewer . ,(concat "pdftotext %s -"))
157          (type   . "application/pdf")
158          ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
159          ("copiousoutput"))
160       ("postscript"       ("postscript"
161        (viewer . "gv -safer %s")        (viewer . "gv -safer %s")
162        (type . "application/postscript")        (type . "application/postscript")
163        (test   . window-system)        (test   . window-system)
164          ("print" . ,(concat mailcap-print-command " %s"))
165        ("needsx11"))        ("needsx11"))
166       ("postscript"       ("postscript"
167        (viewer . "ghostview -dSAFER %s")        (viewer . "ghostview -dSAFER %s")
168        (type . "application/postscript")        (type . "application/postscript")
169        (test   . (eq (mm-device-type) 'x))        (test   . (eq window-system 'x))
170          ("print" . ,(concat mailcap-print-command " %s"))
171        ("needsx11"))        ("needsx11"))
172       ("postscript"       ("postscript"
173        (viewer . "ps2ascii %s")        (viewer . "ps2ascii %s")
174        (type . "application/postscript")        (type . "application/postscript")
175        (test . (not (getenv "DISPLAY")))        (test . (not (getenv "DISPLAY")))
176        ("copiousoutput")))        ("print" . ,(concat mailcap-print-command " %s"))
177          ("copiousoutput"))
178         ("sieve"
179          (viewer . sieve-mode)
180          (test   . (fboundp 'sieve-mode))
181          (type   . "application/sieve"))
182         ("pgp-keys"
183          (viewer . "gpg --import --interactive --verbose")
184          (type   . "application/pgp-keys")
185          ("needsterminal")))
186      ("audio"      ("audio"
187       ("x-mpeg"       ("x-mpeg"
188        (viewer . "maplay %s")        (viewer . "maplay %s")
# Line 173  Line 212 
212        (viewer  . "xwud -in %s")        (viewer  . "xwud -in %s")
213        (type    . "image/x-xwd")        (type    . "image/x-xwd")
214        ("compose" . "xwd -frame > %s")        ("compose" . "xwd -frame > %s")
215        (test    . (eq (mm-device-type) 'x))        (test    . (eq window-system 'x))
216        ("needsx11"))        ("needsx11"))
217       ("x11-dump"       ("x11-dump"
218        (viewer . "xwud -in %s")        (viewer . "xwud -in %s")
219        (type . "image/x-xwd")        (type . "image/x-xwd")
220        ("compose" . "xwd -frame > %s")        ("compose" . "xwd -frame > %s")
221        (test   . (eq (mm-device-type) 'x))        (test   . (eq window-system 'x))
222        ("needsx11"))        ("needsx11"))
223       ("windowdump"       ("windowdump"
224        (viewer . "xwud -in %s")        (viewer . "xwud -in %s")
225        (type . "image/x-xwd")        (type . "image/x-xwd")
226        ("compose" . "xwd -frame > %s")        ("compose" . "xwd -frame > %s")
227        (test   . (eq (mm-device-type) 'x))        (test   . (eq window-system 'x))
228        ("needsx11"))        ("needsx11"))
 ;;; XEmacs says `ns' device-type not implemented.  
 ;;      (".*"  
 ;;       (viewer . "aopen %s")  
 ;;       (type   . "image/*")  
 ;;       (test   . (eq (mm-device-type) 'ns)))  
229       (".*"       (".*"
230        (viewer . "display %s")        (viewer . "display %s")
231        (type . "image/*")        (type . "image/*")
232        (test   . (eq (mm-device-type) 'x))        (test   . (eq window-system 'x))
233        ("needsx11"))        ("needsx11"))
234       (".*"       (".*"
235        (viewer . "ee %s")        (viewer . "ee %s")
236        (type . "image/*")        (type . "image/*")
237        (test   . (eq (mm-device-type) 'x))        (test   . (eq window-system 'x))
238        ("needsx11")))        ("needsx11")))
239      ("text"      ("text"
240       ("plain"       ("plain"
# Line 215  Line 249 
249        (viewer  . fundamental-mode)        (viewer  . fundamental-mode)
250        (type    . "text/plain"))        (type    . "text/plain"))
251       ("enriched"       ("enriched"
252        (viewer . enriched-decode-region)        (viewer . enriched-decode)
253        (test   . (fboundp 'enriched-decode))        (test   . (fboundp 'enriched-decode))
254        (type   . "text/enriched"))        (type   . "text/enriched"))
255       ("html"       ("html"
# Line 226  Line 260 
260       ("mpeg"       ("mpeg"
261        (viewer . "mpeg_play %s")        (viewer . "mpeg_play %s")
262        (type   . "video/mpeg")        (type   . "video/mpeg")
263        (test   . (eq (mm-device-type) 'x))        (test   . (eq window-system 'x))
264        ("needsx11")))        ("needsx11")))
265      ("x-world"      ("x-world"
266       ("x-vrml"       ("x-vrml"
# Line 271  validity.  Otherwise, if it is a non-fun Line 305  validity.  Otherwise, if it is a non-fun
305  whose car is a symbol, it is `eval'led to yield the validity.  If it  whose car is a symbol, it is `eval'led to yield the validity.  If it
306  is a string or list of strings, it represents a shell command to run  is a string or list of strings, it represents a shell command to run
307  to return a true or false shell value for the validity.")  to return a true or false shell value for the validity.")
 (put 'mailcap-mime-data 'risky-local-variable t)  
308    
309  (defcustom mailcap-download-directory nil  (defcustom mailcap-download-directory nil
310    "*Directory to which `mailcap-save-binary-file' downloads files by default.    "*Directory to which `mailcap-save-binary-file' downloads files by default.
# Line 280  nil means your home directory." Line 313  nil means your home directory."
313                   directory)                   directory)
314    :group 'mailcap)    :group 'mailcap)
315    
316    (defvar mailcap-poor-system-types
317      '(ms-dos ms-windows windows-nt win32 w32 mswindows)
318      "Systems that don't have a Unix-like directory hierarchy.")
319    
320  ;;;  ;;;
321  ;;; Utility functions  ;;; Utility functions
322  ;;;  ;;;
# Line 356  MAILCAPS if set; otherwise (on Unix) use Line 393  MAILCAPS if set; otherwise (on Unix) use
393      (cond      (cond
394       (path nil)       (path nil)
395       ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))       ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
396       ((memq system-type '(ms-dos ms-windows windows-nt))       ((memq system-type mailcap-poor-system-types)
397        (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))        (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
398       (t (setq path       (t (setq path
399                ;; This is per RFC 1524, specifically                ;; This is per RFC 1524, specifically
# Line 533  Also return non-nil if no test clause is Line 570  Also return non-nil if no test clause is
570        (cond        (cond
571         ((equal (car (car major)) minor)         ((equal (car (car major)) minor)
572          (setq exact (cons (cdr (car major)) exact)))          (setq exact (cons (cdr (car major)) exact)))
573         ((and minor (string-match (car (car major)) minor))         ((and minor (string-match (concat "^" (car (car major)) "$") minor))
574          (setq wildcard (cons (cdr (car major)) wildcard))))          (setq wildcard (cons (cdr (car major)) wildcard))))
575        (setq major (cdr major)))        (setq major (cdr major)))
576      (nconc exact wildcard)))      (nconc exact wildcard)))
# Line 590  Also return non-nil if no test clause is Line 627  Also return non-nil if no test clause is
627    
628  (defun mailcap-viewer-passes-test (viewer-info type-info)  (defun mailcap-viewer-passes-test (viewer-info type-info)
629    "Return non-nil iff viewer specified by VIEWER-INFO passes its test clause.    "Return non-nil iff viewer specified by VIEWER-INFO passes its test clause.
630  Also retun non-nil if it has no test clause.  TYPE-INFO is an argument  Also return non-nil if it has no test clause.  TYPE-INFO is an argument
631  to supply to the test."  to supply to the test."
632    (let* ((test-info (assq 'test viewer-info))    (let* ((test-info (assq 'test viewer-info))
633           (test (cdr test-info))           (test (cdr test-info))
# Line 619  to supply to the test." Line 656  to supply to the test."
656                 test (list shell-file-name nil nil nil                 test (list shell-file-name nil nil nil
657                            shell-command-switch test)                            shell-command-switch test)
658                 status (apply 'call-process test))                 status (apply 'call-process test))
659           (= 0 status))))           (eq 0 status))))
660        (push (list otest result) mailcap-viewer-test-cache)        (push (list otest result) mailcap-viewer-test-cache)
661        result)))        result)))
662    
# Line 629  to supply to the test." Line 666  to supply to the test."
666          (setq mailcap-mime-data          (setq mailcap-mime-data
667                (cons (cons major (list (cons minor info)))                (cons (cons major (list (cons minor info)))
668                      mailcap-mime-data))                      mailcap-mime-data))
669         (let ((cur-minor (assoc minor old-major)))        (let ((cur-minor (assoc minor old-major)))
670          (cond          (cond
671           ((or (null cur-minor)          ; New minor area, or           ((or (null cur-minor)          ; New minor area, or
672                (assq 'test info))        ; Has a test, insert at beginning                (assq 'test info))        ; Has a test, insert at beginning
673            (setcdr old-major (cons (cons minor info) (cdr old-major))))            (setcdr old-major (cons (cons minor info) (cdr old-major))))
674           ((and (not (assq 'test info))  ; No test info, replace completely           ((and (not (assq 'test info))  ; No test info, replace completely
675                 (not (assq 'test cur-minor))                 (not (assq 'test cur-minor))
676                 (equal (assq 'viewer info)  ; Keep alternative viewer                 (equal (assq 'viewer info)  ; Keep alternative viewer
677                        (assq 'viewer cur-minor)))                        (assq 'viewer cur-minor)))
678            (setcdr cur-minor info))            (setcdr cur-minor info))
679           (t           (t
680            (setcdr old-major (cons (cons minor info) (cdr old-major))))))            (setcdr old-major (cons (cons minor info) (cdr old-major))))))
681        )))        )))
682    
683  (defun mailcap-add (type viewer &optional test)  (defun mailcap-add (type viewer &optional test)
# Line 723  this type is returned." Line 760  this type is returned."
760         ((or (null request) (equal request ""))         ((or (null request) (equal request ""))
761          (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))          (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
762         ((stringp request)         ((stringp request)
763          (if (or (eq request 'test) (eq request 'viewer))          (mailcap-unescape-mime-test
764              (mailcap-unescape-mime-test           (cdr-safe (assoc request viewer)) info))
              (cdr-safe (assoc request viewer)) info)))  
765         ((eq request 'all)         ((eq request 'all)
766          passed)          passed)
767         (t         (t
# Line 808  this type is returned." Line 844  this type is returned."
844      (".rtx"   . "text/richtext")      (".rtx"   . "text/richtext")
845      (".sh"    . "application/x-sh")      (".sh"    . "application/x-sh")
846      (".sit"   . "application/x-stuffit")      (".sit"   . "application/x-stuffit")
847        (".siv"   . "application/sieve")
848      (".snd"   . "audio/basic")      (".snd"   . "audio/basic")
849      (".src"   . "application/x-wais-source")      (".src"   . "application/x-wais-source")
850      (".tar"   . "archive/tar")      (".tar"   . "archive/tar")
# Line 825  this type is returned." Line 862  this type is returned."
862      (".vox"   . "audio/basic")      (".vox"   . "audio/basic")
863      (".vrml"  . "x-world/x-vrml")      (".vrml"  . "x-world/x-vrml")
864      (".wav"   . "audio/x-wav")      (".wav"   . "audio/x-wav")
865        (".xls"   . "application/vnd.ms-excel")
866      (".wrl"   . "x-world/x-vrml")      (".wrl"   . "x-world/x-vrml")
867      (".xbm"   . "image/xbm")      (".xbm"   . "image/xbm")
868      (".xpm"   . "image/xpm")      (".xpm"   . "image/xpm")
# Line 851  If FORCE, re-parse even if already parse Line 889  If FORCE, re-parse even if already parse
889      (cond      (cond
890       (path nil)       (path nil)
891       ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))       ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
892       ((memq system-type '(ms-dos ms-windows windows-nt))       ((memq system-type mailcap-poor-system-types)
893        (setq path '("~/mime.typ" "~/etc/mime.typ")))        (setq path '("~/mime.typ" "~/etc/mime.typ")))
894       (t (setq path       (t (setq path
895                ;; mime.types seems to be the normal name, definitely so                ;; mime.types seems to be the normal name, definitely so

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.9.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26