;;; mm-decode.el --- Functions for decoding MIME things
-;; Copyright (C) 1998,99 Free Software Foundation, Inc.
+;; Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
+(eval-when-compile (require 'cl))
+
+(eval-and-compile
+ (autoload 'mm-inline-partial "mm-partial"))
(defgroup mime-display ()
"Display of MIME in mail and news articles."
(locate-library "vcard"))))
("message/delivery-status" mm-inline-text identity)
("message/rfc822" mm-inline-message identity)
+ ("message/partial" mm-inline-partial identity)
("text/.*" mm-inline-text identity)
("audio/wav" mm-inline-audio
(lambda (handle)
(defcustom mm-inlined-types
'("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
+ "message/partial"
"application/pgp-signature")
"List of media types that are to be displayed inline."
:type '(repeat string)
:type '(repeat string)
:group 'mime-display)
-(defcustom mm-inline-override-types nil
- "Types to be treated as attachments even if they can be displayed inline."
- :type '(repeat string)
- :group 'mime-display)
-
(defcustom mm-automatic-external-display nil
"List of MIME type regexps that will be displayed externally automatically."
:type '(repeat string)
Viewing agents are supposed to view the last possible part of a message,
as that is supposed to be the richest. However, users may prefer other
types instead, and this list says what types are most unwanted. If,
-for instance, text/html parts are very unwanted, and text/richtech are
+for instance, text/html parts are very unwanted, and text/richtext are
somewhat unwanted, then the value of this variable should be set
to:
cd (mail-fetch-field "content-disposition")
description (mail-fetch-field "content-description")
id (mail-fetch-field "content-id"))))
+ (when cte
+ (setq cte (mail-header-strip cte)))
(if (or (not ctl)
(not (string-match "/" (car ctl))))
(mm-dissect-singlepart
- '("text/plain")
+ '("text/plain")
(and cte (intern (downcase (mail-header-remove-whitespace
(mail-header-remove-comments
cte)))))
(defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
(when (or force
- (not (equal "text/plain" (car ctl))))
+ (if (equal "text/plain" (car ctl))
+ (assoc 'format ctl)
+ t))
(let ((res (mm-make-handle
(mm-copy-to-buffer) ctl cte nil cdl description nil id)))
(push (car res) mm-dissection-list)
(unwind-protect
(start-process "*display*" nil
"xterm"
- "-e" shell-file-name
+ "-e" shell-file-name
shell-command-switch
(mm-mailcap-command
method file (mm-handle-type handle)))
(unwind-protect
(progn
(call-process shell-file-name nil
- (setq buffer
+ (setq buffer
(generate-new-buffer "*mm*"))
nil
shell-command-switch
(defun mm-mailcap-command (method file type-list)
(let ((ctl (cdr type-list))
(beg 0)
+ (uses-stdin t)
out sub total)
- (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t" method beg)
+ (while (string-match "%{\\([^}]+\\)}\\|%s\\|%t\\|%%" method beg)
(push (substring method beg (match-beginning 0)) out)
(setq beg (match-end 0)
total (match-string 0 method)
sub (match-string 1 method))
(cond
+ ((string= total "%%")
+ (push "%" out))
((string= total "%s")
+ (setq uses-stdin nil)
(push (mm-quote-arg file) out))
((string= total "%t")
(push (mm-quote-arg (car type-list)) out))
(t
(push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
(push (substring method beg (length method)) out)
+ (if uses-stdin
+ (progn
+ (push "<" out)
+ (push (mm-quote-arg file) out)))
(mapconcat 'identity (nreverse out) "")))
(defun mm-remove-parts (handles)
- "Remove the displayed MIME parts represented by HANDLE."
+ "Remove the displayed MIME parts represented by HANDLES."
(if (and (listp handles)
(bufferp (car handles)))
(mm-remove-part handles)
(mm-remove-part handle)))))))
(defun mm-destroy-parts (handles)
- "Remove the displayed MIME parts represented by HANDLE."
+ "Remove the displayed MIME parts represented by HANDLES."
(if (and (listp handles)
(bufferp (car handles)))
(mm-destroy-part handles)
(mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
(mailcap-mime-info type 'all)))
(method (completing-read "Viewer: " methods)))
+ (when (string= method "")
+ (error "No method given"))
(mm-display-external (copy-sequence handle) method)))
(defun mm-preferred-alternative (handles &optional preferred)
result))
(defun mm-preferred-alternative-precedence (handles)
- "Return the precedence based on HANDLES and mm-discouraged-alternatives."
- (let ((seq (nreverse (mapcar (lambda (h)
- (mm-handle-media-type h))
+ "Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
+ (let ((seq (nreverse (mapcar #'mm-handle-media-type
handles))))
(dolist (disc (reverse mm-discouraged-alternatives))
(dolist (elem (copy-sequence seq))
(prog1
(setq spec
(ignore-errors
- (cond
- ((equal type "xbm")
- ;; xbm images require special handling, since
- ;; the only way to create glyphs from these
- ;; (without a ton of work) is to write them
- ;; out to a file, and then create a file
- ;; specifier.
- (let ((file (make-temp-name
- (expand-file-name "emm.xbm"
- mm-tmp-directory))))
- (unwind-protect
- (progn
- (write-region (point-min) (point-max) file)
- (make-glyph (list (cons 'x file))))
- (ignore-errors
- (delete-file file)))))
- (t
- (make-glyph
- (vector (intern type) :data (buffer-string)))))))
+ (if (fboundp 'make-glyph)
+ (cond
+ ((equal type "xbm")
+ ;; xbm images require special handling, since
+ ;; the only way to create glyphs from these
+ ;; (without a ton of work) is to write them
+ ;; out to a file, and then create a file
+ ;; specifier.
+ (let ((file (make-temp-name
+ (expand-file-name "emm.xbm"
+ mm-tmp-directory))))
+ (unwind-protect
+ (progn
+ (write-region (point-min) (point-max) file)
+ (make-glyph (list (cons 'x file))))
+ (ignore-errors
+ (delete-file file)))))
+ (t
+ (make-glyph
+ (vector (intern type) :data (buffer-string)))))
+ (create-image (buffer-string) (intern type) 'data-p))))
(mm-handle-set-cache handle spec))))))
(defun mm-image-fit-p (handle)
"Say whether the image in HANDLE will fit the current window."
(let ((image (mm-get-image handle)))
- (or mm-inline-large-images
- (and (< (glyph-width image) (window-pixel-width))
- (< (glyph-height image) (window-pixel-height))))))
+ (if (fboundp 'glyph-width)
+ ;; XEmacs' glyphs can actually tell us about their width, so
+ ;; lets be nice and smart about them.
+ (or mm-inline-large-images
+ (and (< (glyph-width image) (window-pixel-width))
+ (< (glyph-height image) (window-pixel-height))))
+ ;; Let's just inline everything under Emacs 21, since the image
+ ;; specification there doesn't actually get the width/height
+ ;; until you render the image.
+ t)))
(defun mm-valid-image-format-p (format)
"Say whether FORMAT can be displayed natively by Emacs."
- (and (fboundp 'valid-image-instantiator-format-p)
- (valid-image-instantiator-format-p format)))
+ (cond
+ ;; Handle XEmacs
+ ((fboundp 'valid-image-instantiator-format-p)
+ (valid-image-instantiator-format-p format))
+ ;; Handle Emacs 21
+ ((fboundp 'image-type-available-p)
+ (and (display-graphic-p)
+ (image-type-available-p format)))
+ ;; Nobody else can do images yet.
+ (t
+ nil)))
(defun mm-valid-and-fit-image-p (format handle)
"Say whether FORMAT can be displayed natively and HANDLE fits the window."
(provide 'mm-decode)
-;; mm-decode.el ends here
+;;; mm-decode.el ends here
projects / gnus / blobdiff