X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=lisp%2Fmailcap.el;h=7a1c05bf09eeb3b82bdc016845c2552e071dec3e;hb=3aca09c100b6c60da9524bebf9c9eed6ad3e0174;hp=0cf68b2f1db86988df7268ca10fa5259cfc0edfe;hpb=08d3497d2d2341b43f77ce58b0d4a1b183a11beb;p=elisp%2Fgnus.git- diff --git a/lisp/mailcap.el b/lisp/mailcap.el index 0cf68b2..7a1c05b 100644 --- a/lisp/mailcap.el +++ b/lisp/mailcap.el @@ -1,5 +1,5 @@ ;;; 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 ;; Lars Magne Ingebrigtsen @@ -51,6 +51,7 @@ (type . "application/x-x509-user-cert")) ("octet-stream" (viewer . mailcap-save-binary-file) + (non-viewer . t) (type ."application/octet-stream")) ("dvi" (viewer . "open %s") @@ -70,6 +71,7 @@ (type . "application/emacs-lisp")) ("x-tar" (viewer . mailcap-save-binary-file) + (non-viewer . t) (type . "application/x-tar")) ("x-latex" (viewer . tex-mode) @@ -93,6 +95,7 @@ (type . "application/tex")) ("zip" (viewer . mailcap-save-binary-file) + (non-viewer . t) (type . "application/zip") ("copiousoutput")) ("pdf" @@ -103,7 +106,7 @@ (type . "application/postscript") (test . (eq (mm-device-type) 'ns))) ("postscript" - (viewer . "ghostview %s") + (viewer . "ghostview -dSAFER %s") (type . "application/postscript") (test . (eq (mm-device-type) 'x)) ("needsx11")) @@ -117,7 +120,8 @@ (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/*")) @@ -126,25 +130,25 @@ (type . "audio/*"))) ("message" ("rfc-*822" - (viewer . gnus-article-prepare-display) + (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")) + (type . "message/rfc822")) ("rfc-*822" (viewer . fundamental-mode) - (type . "message/rfc-822"))) + (type . "message/rfc822"))) ("image" ("x-xwd" (viewer . "xwud -in %s") @@ -169,7 +173,12 @@ (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"))) @@ -210,7 +219,7 @@ (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) @@ -241,7 +250,10 @@ not.") (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.") ;;; @@ -271,11 +283,13 @@ not.") (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 () @@ -299,14 +313,15 @@ not.") (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" @@ -321,7 +336,8 @@ If FORCE, re-parse even if already parsed." 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))) @@ -358,9 +374,9 @@ If FORCE, re-parse even if already parsed." (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 @@ -368,7 +384,12 @@ If FORCE, re-parse even if already parsed." (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)) @@ -403,14 +424,13 @@ If FORCE, re-parse even if already parsed." (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) '(?\" ?')) @@ -423,13 +443,14 @@ If FORCE, re-parse even if already parsed." (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))) + (setq results (cons (cons name value) results)) + (skip-chars-forward " \";\n\t")) results))) (defun mailcap-mailcap-entry-passes-test (info) @@ -439,7 +460,10 @@ If FORCE, re-parse even if already parsed." (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") @@ -468,7 +492,7 @@ If FORCE, re-parse even if already parsed." (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)))) @@ -575,6 +599,19 @@ If FORCE, re-parse even if already parsed." (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 ;;; @@ -709,6 +746,7 @@ this type is returned." (".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") @@ -744,14 +782,13 @@ this type is returned." (".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 @@ -820,16 +857,30 @@ correspond to.") (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." + "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) + file dir) (catch 'found - (while path - (when (and (file-executable-p - (setq file (expand-file-name command (pop path)))) - (not (file-directory-p file))) - (throw 'found file)))))) + (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)