;;; mailcap.el --- Functions for displaying MIME parts
-;; Copyright (C) 1998 Free Software Foundation, Inc.
+;; Copyright (C) 1998,99 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
(type . "application/x-x509-user-cert"))
("octet-stream"
(viewer . mailcap-save-binary-file)
+ (non-viewer . t)
(type ."application/octet-stream"))
("dvi"
(viewer . "open %s")
(type . "application/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"))
("pdf"
(viewer . "open %s")
(type . "application/postscript")
(test . (eq (mm-device-type) 'ns)))
- ("postscript"
- (viewer . "ghostview %s")
+ ("postscript"
+ (viewer . "ghostview -dSAFER %s")
(type . "application/postscript")
(test . (eq (mm-device-type) 'x))
("needsx11"))
(viewer . "maplay %s")
(type . "audio/x-mpeg"))
(".*"
- (viewer . mm-view-sound-file)
+ (viewer . mailcap-save-binary-file)
+ (non-viewer . t)
(test . (or (featurep 'nas-sound)
(featurep 'native-sound)))
(type . "audio/*"))
(type . "audio/*")))
("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/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"
+ (type . "message/rfc822"))
+ ("rfc-*822"
(viewer . fundamental-mode)
- (type . "message/rfc-822")))
+ (type . "message/rfc822")))
("image"
("x-xwd"
(viewer . "xwud -in %s")
(type . "image/*")
(test . (eq (mm-device-type) 'ns)))
(".*"
- (viewer . "xv -perfect %s")
+ (viewer . "display %s")
+ (type . "image/*")
+ (test . (eq (mm-device-type) 'x))
+ ("needsx11"))
+ (".*"
+ (viewer . "ee %s")
(type . "image/*")
(test . (eq (mm-device-type) 'x))
("needsx11")))
(type . "text/plain"))
("enriched"
(viewer . enriched-decode-region)
- (test . (fboundp 'enriched-decode-region))
+ (test . (fboundp 'enriched-decode))
(type . "text/enriched"))
("html"
(viewer . mm-w3-prepare-buffer)
(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)
(defvar mailcap-download-directory nil
"*Where downloaded files should go by default.")
-(defvar mailcap-temporary-directory (or (getenv "TMPDIR") "/tmp")
+(defvar mailcap-temporary-directory
+ (cond ((fboundp 'temp-directory) (temp-directory))
+ ((boundp 'temporary-file-directory) temporary-file-directory)
+ ("/tmp/"))
"*Where temporary files go.")
;;;
(expand-file-name fname mailcap-temporary-directory))))
(defun mailcap-save-binary-file ()
- (let ((file (read-file-name
- "Filename to save as: "
- (or mailcap-download-directory "~/")))
- (require-final-newline nil))
- (write-region (point-min) (point-max) file)
+ (goto-char (point-min))
+ (unwind-protect
+ (let ((file (read-file-name
+ "Filename to save as: "
+ (or mailcap-download-directory "~/")))
+ (require-final-newline nil))
+ (write-region (point-min) (point-max) file))
(kill-buffer (current-buffer))))
(defun mailcap-maybe-eval ()
(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."
- (interactive)
+ (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")
+ (setq path (mapconcat 'expand-file-name
+ '("~/mail.cap" "~/etc/mail.cap" "~/.mailcap")
";")))
(t (setq path (mapconcat 'expand-file-name
'("~/.mailcap"
fname)
(while fnames
(setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname))
+ (if (and (file-exists-p fname) (file-readable-p fname)
+ (file-regular-p fname))
(mailcap-parse-mailcap (car fnames)))
(setq fnames (cdr fnames))))
(setq mailcap-parsed-p t)))
(downcase-region save-pos (point))
(setq minor
(cond
- ((= ?* (or (char-after save-pos) 0)) ".*")
+ ((eq ?* (or (char-after save-pos) 0)) ".*")
((= (point) save-pos) ".*")
- (t (buffer-substring save-pos (point)))))
+ (t (regexp-quote (buffer-substring save-pos (point))))))
(skip-chars-forward "; \t\n")
;;; Got the major/minor chunks, now for the viewers/etc
;;; The first item _must_ be a viewer, according to the
(skip-chars-forward "; \t\n")
(setq save-pos (point))
(skip-chars-forward "^;\n")
- (if (= (or (char-after save-pos) 0) ?')
+ ;;; skip \;
+ (while (eq (char-before) ?\\)
+ (backward-delete-char 1)
+ (skip-chars-forward ";")
+ (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))
(skip-chars-forward " \n\t;")
(while (not (eobp))
(setq done nil)
- (skip-chars-forward " \";\n\t")
(setq name-pos (point))
- (skip-chars-forward "^ \n\t=")
+ (skip-chars-forward "^ \n\t=;")
(downcase-region name-pos (point))
(setq name (buffer-substring name-pos (point)))
(skip-chars-forward " \t\n")
- (if (/= (or (char-after (point)) 0) ?=) ; There is no value
- (setq value nil)
+ (if (not (eq (char-after (point)) ?=)) ; There is no value
+ (setq value t)
(skip-chars-forward " \t\n=")
(setq val-pos (point))
(if (memq (char-after val-pos) '(?\" ?'))
(error (goto-char (point-max)))))
(while (not done)
(skip-chars-forward "^;")
- (if (= (or (char-after (1- (point))) 0) ?\\ )
+ (if (eq (char-after (1- (point))) ?\\ )
(progn
(subst-char-in-region (1- (point)) (point) ?\\ ? )
(skip-chars-forward ";"))
(setq done t))))
(setq value (buffer-substring val-pos (point))))
- (setq results (cons (cons name value) results)))
- results)))
+ (setq results (cons (cons name value) results))
+ (skip-chars-forward " \";\n\t"))
+ results)))
(defun mailcap-mailcap-entry-passes-test (info)
;; Return t iff a mailcap entry passes its test clause or no test
(test (assq 'test info)) ; The test clause
)
(setq status (and test (split-string (cdr test) " ")))
- (if (and (assoc "needsx11" info) (not (getenv "DISPLAY")))
+ (if (and (or (assoc "needsterm" info)
+ (assoc "needsterminal" info)
+ (assoc "needsx11" info))
+ (not (getenv "DISPLAY")))
(setq status nil)
(cond
((and (equal (nth 0 status) "test")
(cond
((equal (car (car major)) minor)
(setq exact (cons (cdr (car major)) exact)))
- ((string-match (car (car major)) minor)
+ ((and minor (string-match (car (car major)) minor))
(setq wildcard (cons (cdr (car major)) wildcard))))
(setq major (cdr major)))
(nconc (nreverse exact) (nreverse wildcard))))
(t
(setcdr old-major (cons (cons minor info) (cdr old-major)))))))))
+(defun mailcap-add (type viewer &optional test)
+ "Add VIEWER as a handler for TYPE.
+If TEST is not given, it defaults to t."
+ (let ((tl (split-string type "/")))
+ (when (or (not (car tl))
+ (not (cadr tl)))
+ (error "%s is not a valid MIME type" type))
+ (mailcap-add-mailcap-entry
+ (car tl) (cadr tl)
+ `((viewer . ,viewer)
+ (test . ,(if test test t))
+ (type . ,type)))))
+
;;;
;;; The main whabbo
;;;
(defun mailcap-mime-info (string &optional request)
"Get the MIME viewer command for STRING, return nil if none found.
-Expects a complete content-type header line as its argument.
+Expects a complete content-type header line as its argument.
Second argument REQUEST specifies what information to return. If it is
nil or the empty string, the viewer (second field of the mailcap
(".nc" . "application/x-netcdf")
(".nc" . "application/x-netcdf")
(".oda" . "application/oda")
+ (".patch" . "text/x-patch")
(".pbm" . "image/x-portable-bitmap")
(".pdf" . "application/pdf")
(".pgm" . "image/portable-graymap")
(".wav" . "audio/x-wav")
(".wrl" . "x-world/x-vrml")
(".xbm" . "image/xbm")
- (".xpm" . "image/x-pixmap")
+ (".xpm" . "image/xpm")
(".xwd" . "image/windowdump")
(".zip" . "application/zip")
(".ai" . "application/postscript")
(".jpe" . "image/jpeg")
(".jpeg" . "image/jpeg"))
- "*An assoc list of file extensions and the MIME content-types they
-correspond to.")
+ "An assoc list of file extensions and corresponding MIME content-types.")
(defun mailcap-parse-mimetypes (&optional path)
;; Parse out all the mimetypes specified in a unix-style path string PATH
(setq extn (concat "." extn)))
(cdr (assoc (downcase extn) mailcap-mime-extensions)))
+(defvar mailcap-binary-suffixes
+ (if (memq system-type '(ms-dos windows-nt))
+ '(".exe" ".com" ".bat" ".cmd" ".btm" "")
+ '("")))
+
+(defun mailcap-command-p (command)
+ "Say whether COMMAND is in the exec path.
+The path of COMMAND will be returned iff COMMAND is a command."
+ (let ((path (if (file-name-absolute-p command) '(nil) exec-path))
+ file dir)
+ (catch 'found
+ (while (setq dir (pop path))
+ (let ((suffixes mailcap-binary-suffixes))
+ (while suffixes
+ (when (and (file-executable-p
+ (setq file (expand-file-name
+ (concat command (pop suffixes))
+ dir)))
+ (not (file-directory-p file)))
+ (throw 'found file))))))))
+
+(defun mailcap-mime-types ()
+ "Return a list of MIME media types."
+ (delete-duplicates (mapcar 'cdr mailcap-mime-extensions)))
+
(provide 'mailcap)
;;; mailcap.el ends here
projects / elisp / gnus.git- / blobdiff