;;; mailcap.el --- Functions for displaying MIME parts
-;; Copyright (C) 1998,99 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;;; Code:
-(eval-and-compile
- (require 'cl))
+(eval-when-compile (require 'cl))
(require 'mail-parse)
+(require 'mm-util)
(defvar mailcap-parse-args-syntax-table
(let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
(viewer . "maplay %s")
(type . "audio/x-mpeg"))
(".*"
- (viewer . mailcap-save-binary-file)
- (non-viewer . t)
- (test . (or (featurep 'nas-sound)
- (featurep 'native-sound)))
- (type . "audio/*"))
- (".*"
(viewer . "showaudio")
(type . "audio/*")))
("message"
(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")
(viewer . "ee %s")
(type . "image/*")
(test . (eq (mm-device-type) 'x))
- ("needsx11"))
- (".*"
- (viewer . "xv -perfect %s")
- (type . "image/*")
- (test . (eq (mm-device-type) 'x))
("needsx11")))
("text"
("plain"
(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)
;;;
(defun mailcap-generate-unique-filename (&optional fmt)
- "Generate a unique filename in mailcap-temporary-directory"
+ "Generate a unique filename in mailcap-temporary-directory."
(if (not fmt)
(let ((base (format "mailcap-tmp.%d" (user-real-uid)))
(fname "")
(kill-buffer (current-buffer))))
(defun mailcap-maybe-eval ()
- "Maybe evaluate a buffer of emacs lisp code"
+ "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)))
fname)
(while fnames
(setq fname (car fnames))
- (if (and (file-exists-p fname) (file-readable-p fname)
- (file-regular-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)))
(skip-chars-forward " \t\n")
(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\n")
+ (setq minor "")
+ (when (eq (char-after) ?/)
+ (forward-char)
+ (skip-chars-forward " \t\n")
+ (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\n")
;;; 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))))
+ (setq viewer "")
+ (when (eq (char-after) ?\;)
+ (forward-char)
+ (skip-chars-forward " \t\n")
+ (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-substring save-pos (point)))))
(setq save-pos (point))
(end-of-line)
- (setq info (nconc (list (cons 'viewer viewer)
- (cons 'type (concat major "/"
- (if (string= minor ".*")
- "*" minor))))
- (mailcap-parse-mailcap-extras save-pos (point))))
- (mailcap-mailcap-entry-passes-test info)
- (mailcap-add-mailcap-entry major minor info)))))
+ (unless (equal viewer "")
+ (setq info (nconc (list (cons 'viewer viewer)
+ (cons 'type (concat major "/"
+ (if (string= minor ".*")
+ "*" minor))))
+ (mailcap-parse-mailcap-extras save-pos (point))))
+ (mailcap-mailcap-entry-passes-test info)
+ (mailcap-add-mailcap-entry major minor info))))))
(defun mailcap-parse-mailcap-extras (st nd)
;; Grab all the extra stuff from a mailcap entry
(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 (not (eq (char-after (point)) ?=)) ; There is no value
- (setq value nil)
+ (setq value t)
(skip-chars-forward " \t\n=")
(setq val-pos (point))
(if (memq (char-after val-pos) '(?\" ?'))
(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)
)
(setq status (and test (split-string (cdr test) " ")))
(if (and (or (assoc "needsterm" info)
+ (assoc "needsterminal" info)
(assoc "needsx11" info))
(not (getenv "DISPLAY")))
(setq status nil)
((or (null cur-minor) ; New minor area, or
(assq 'test info)) ; Has a test, insert at beginning
(setcdr old-major (cons (cons minor info) (cdr old-major))))
- ((and (not (assq 'test info)) ; No test info, replace completely
+ ((and (not (assq 'test info)) ; No test info, replace completely
(not (assq 'test cur-minor)))
(setcdr cur-minor info))
(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
;;;
(x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
(y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) "")))))
(cond
- ((and x-lisp (not y-lisp))
- t)
- ((and (not y-lisp) x-wild (not y-wild))
- t)
+ ((and x-wild (not y-wild))
+ nil)
((and (not x-wild) y-wild)
t)
+ ((and (not y-lisp) x-lisp)
+ t)
(t nil))))
(defun mailcap-mime-info (string &optional request)
(setq viewers (cdr viewers)))
(setq passed (sort (nreverse passed) 'mailcap-viewer-lessp))
(setq viewer (car passed))))
+ (setq passed (nreverse passed))
(when (and (stringp (cdr (assq 'viewer viewer)))
passed)
(setq viewer (car passed)))
passed)
(t
;; MUST make a copy *sigh*, else we modify mailcap-mime-data
- (setq viewer (copy-tree viewer))
+ (setq viewer (copy-sequence viewer))
(let ((view (assq 'viewer viewer))
(test (assq 'test viewer)))
(if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
(".cdf" . "application/x-netcdr")
(".cpio" . "application/x-cpio")
(".csh" . "application/x-csh")
+ (".css" . "text/css")
(".dvi" . "application/x-dvi")
+ (".diff" . "text/x-patch")
(".el" . "application/emacs-lisp")
(".eps" . "application/postscript")
(".etx" . "text/x-setext")
(".nc" . "application/x-netcdf")
(".nc" . "application/x-netcdf")
(".oda" . "application/oda")
- (".patch" . "application/x-patch")
+ (".patch" . "text/x-patch")
(".pbm" . "image/x-portable-bitmap")
(".pdf" . "application/pdf")
(".pgm" . "image/portable-graymap")
((memq system-type '(ms-dos ms-windows windows-nt))
(setq path (mapconcat 'expand-file-name
'("~/mime.typ" "~/etc/mime.typ") ";")))
- (t (setq path (mapconcat 'expand-file-name
- '("~/.mime-types"
- "/etc/mime-types:/usr/etc/mime-types"
- "/usr/local/etc/mime-types"
- "/usr/local/www/conf/mime-types") ":"))))
+ (t (setq path (mapconcat
+ 'expand-file-name
+ ;; mime.types seems to be the normal name,
+ ;; definitely so on current GNUish systems. The
+ ;; ordering follows that for mailcap.
+ '("~/.mime.types"
+ "/etc/mime.types"
+ "/usr/etc/mime.types"
+ "/usr/local/etc/mime.types"
+ "/usr/local/www/conf/mime.types"
+ "~/.mime-types"
+ "/etc/mime-types"
+ "/usr/etc/mime-types"
+ "/usr/local/etc/mime-types"
+ "/usr/local/www/conf/mime-types") ":"))))
(let ((fnames (reverse
(split-string path
(if (memq system-type
(not (file-directory-p file)))
(throw 'found file))))))))
+(defun mailcap-mime-types ()
+ "Return a list of MIME media types."
+ (mm-delete-duplicates (mapcar 'cdr mailcap-mime-extensions)))
+
(provide 'mailcap)
;;; mailcap.el ends here
projects / elisp / gnus.git- / blobdiff