;;; mailcap.el --- MIME media types configuration
;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005 Free Software Foundation, Inc.
+;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: William M. Perry <wmperry@aventail.com>
;; Lars Magne Ingebrigtsen <larsi@gnus.org>
;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;;; Code:
(eval-when-compile (require 'cl))
-(require 'mail-parse)
-(require 'mm-util)
+(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))
(defgroup mailcap nil
"Definition of viewers for MIME types."
(skip-chars-forward ";"))
(setq done t))))
(setq value (buffer-substring val-pos (point))))
- (setq results (cons (cons name value) results))
+ ;; `test' as symbol, others like "copiousoutput" and "needsx11" as
+ ;; strings
+ (setq results (cons (cons (if (string-equal name "test")
+ 'test
+ name)
+ value) results))
(skip-chars-forward " \";\n\t"))
results)))
(defun mailcap-mailcap-entry-passes-test (info)
- "Return non-nil iff mailcap entry INFO passes its test clause.
+ "Return non-nil if mailcap entry INFO passes its test clause.
Also return non-nil if no test clause is present."
(let ((test (assq 'test info)) ; The test clause
status)
(defvar mailcap-viewer-test-cache nil)
(defun mailcap-viewer-passes-test (viewer-info type-info)
- "Return non-nil iff viewer specified by VIEWER-INFO passes its test clause.
+ "Return non-nil if viewer specified by VIEWER-INFO passes its test clause.
Also return non-nil if it has no test clause. TYPE-INFO is an argument
to supply to the test."
(let* ((test-info (assq 'test viewer-info))
(viewer (cdr (assoc 'viewer viewer-info)))
(default-directory (expand-file-name "~/"))
status parsed-test cache result)
- (if (setq cache (assoc test mailcap-viewer-test-cache))
- (cadr cache)
- (setq
- result
- (cond
- ((not test-info) t) ; No test clause
- ((not test) nil) ; Already failed test
- ((eq test t) t) ; Already passed test
- ((functionp test) ; Lisp function as test
- (funcall test type-info))
- ((and (symbolp test) ; Lisp variable as test
- (boundp test))
- (symbol-value test))
- ((and (listp test) ; List to be eval'd
- (symbolp (car test)))
- (eval test))
- (t
- (setq test (mailcap-unescape-mime-test test type-info)
- test (list shell-file-name nil nil nil
- shell-command-switch test)
- status (apply 'call-process test))
- (eq 0 status))))
- (push (list otest result) mailcap-viewer-test-cache)
- result)))
+ (cond ((setq cache (assoc test mailcap-viewer-test-cache))
+ (cadr cache))
+ ((not test-info) t) ; No test clause
+ (t
+ (setq
+ result
+ (cond
+ ((not test) nil) ; Already failed test
+ ((eq test t) t) ; Already passed test
+ ((functionp test) ; Lisp function as test
+ (funcall test type-info))
+ ((and (symbolp test) ; Lisp variable as test
+ (boundp test))
+ (symbol-value test))
+ ((and (listp test) ; List to be eval'd
+ (symbolp (car test)))
+ (eval test))
+ (t
+ (setq test (mailcap-unescape-mime-test test type-info)
+ test (list shell-file-name nil nil nil
+ shell-command-switch test)
+ status (apply 'call-process test))
+ (eq 0 status))))
+ (push (list otest result) mailcap-viewer-test-cache)
+ result))))
(defun mailcap-add-mailcap-entry (major minor info)
(let ((old-major (assoc major mailcap-mime-data)))
;;;
(defun mailcap-viewer-lessp (x y)
- "Return t iff viewer X is more desirable than viewer Y."
+ "Return t if viewer X is more desirable than viewer Y."
(let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
(y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
(x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
t)
(t nil))))
-(defun mailcap-mime-info (string &optional request)
+(defun mailcap-mime-info (string &optional request no-decode)
"Get the MIME viewer command for STRING, return nil if none found.
Expects a complete content-type header line as its argument.
corresponding to that string will be returned (print, description,
whatever). If a number, then all the information for this specific
viewer is returned. If `all', then all possible viewers for
-this type is returned."
+this type is returned.
+
+If NO-DECODE is non-nil, don't decode STRING."
+ ;; NO-DECODE avoids calling `mail-header-parse-content-type' from
+ ;; `mail-parse.el'
(let (
major ; Major encoding (text, etc)
minor ; Minor encoding (html, etc)
viewer ; The one and only viewer
ctl)
(save-excursion
- (setq ctl (mail-header-parse-content-type (or string "text/plain")))
+ (setq ctl
+ (if no-decode
+ (list (or string "text/plain"))
+ (mail-header-parse-content-type (or string "text/plain"))))
(setq major (split-string (car ctl) "/"))
(setq minor (cadr major)
major (car major))
(setq viewer (car passed)))
(cond
((and (null viewer) (not (equal major "default")) request)
- (mailcap-mime-info "default" request))
+ (mailcap-mime-info "default" request no-decode))
((or (null request) (equal request ""))
(mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
((stringp request)
(defun mailcap-mime-types ()
"Return a list of MIME media types."
(mailcap-parse-mimetypes)
- (mm-delete-duplicates
+ (mailcap-delete-duplicates
(nconc
(mapcar 'cdr mailcap-mime-extensions)
(apply
projects / gnus / blobdiff