From 407b9daa92be113f0b914ea806051277304691f5 Mon Sep 17 00:00:00 2001 From: ShengHuo ZHU Date: Thu, 2 Nov 2000 22:13:52 +0000 Subject: [PATCH] 2000-11-02 16:53:32 ShengHuo ZHU * mm-partial.el (mm-inline-partial): Buffer name with a leading space. * mm-decode.el (mm-display-external): Ditto. * mm-extern.el: New file. * mm-decode.el (mm-inline-media-tests): Hook it up. (mm-inlined-types): Inline message/external-body. --- lisp/ChangeLog | 8 ++++ lisp/mm-decode.el | 16 ++++--- lisp/mm-extern.el | 114 +++++++++++++++++++++++++++++++++++++++++++++ lisp/mm-partial.el | 2 +- 4 files changed, 132 insertions(+), 8 deletions(-) create mode 100644 lisp/mm-extern.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3c1f75670..f7a6e613b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2000-11-02 16:53:32 ShengHuo ZHU + + * mm-partial.el (mm-inline-partial): Buffer name with a leading space. + * mm-decode.el (mm-display-external): Ditto. + * mm-extern.el: New file. + * mm-decode.el (mm-inline-media-tests): Hook it up. + (mm-inlined-types): Inline message/external-body. + 2000-11-02 Simon Josefsson * gnus-art.el (gnus-visible-headers): Add Mail-Followup-To. diff --git a/lisp/mm-decode.el b/lisp/mm-decode.el index 7489d3dde..9f30ae4ad 100644 --- a/lisp/mm-decode.el +++ b/lisp/mm-decode.el @@ -30,7 +30,8 @@ (eval-when-compile (require 'cl)) (eval-and-compile - (autoload 'mm-inline-partial "mm-partial")) + (autoload 'mm-inline-partial "mm-partial") + (autoload 'mm-inline-external-body "mm-extern")) (defgroup mime-display () "Display of MIME in mail and news articles." @@ -131,6 +132,7 @@ ("message/delivery-status" mm-inline-text identity) ("message/rfc822" mm-inline-message identity) ("message/partial" mm-inline-partial identity) + ("message/external-body" mm-inline-external-body identity) ("text/.*" mm-inline-text identity) ("audio/wav" mm-inline-audio (lambda (handle) @@ -153,7 +155,7 @@ (defcustom mm-inlined-types '("image/.*" "text/.*" "message/delivery-status" "message/rfc822" - "message/partial" "application/emacs-lisp" + "message/partial" "message/external-body" "application/emacs-lisp" "application/pgp-signature") "List of media types that are to be displayed inline." :type '(repeat string) @@ -400,13 +402,13 @@ external if displayed external." (let ((cur (current-buffer))) (if (eq method 'mailcap-save-binary-file) (progn - (set-buffer (generate-new-buffer "*mm*")) + (set-buffer (generate-new-buffer " *mm*")) (setq method nil)) (mm-insert-part handle) (let ((win (get-buffer-window cur t))) (when win (select-window win))) - (switch-to-buffer (generate-new-buffer "*mm*"))) + (switch-to-buffer (generate-new-buffer " *mm*"))) (buffer-disable-undo) (mm-set-buffer-file-coding-system mm-binary-coding-system) (insert-buffer-substring cur) @@ -464,7 +466,7 @@ external if displayed external." (progn (call-process shell-file-name nil (setq buffer - (generate-new-buffer "*mm*")) + (generate-new-buffer " *mm*")) nil shell-command-switch (mm-mailcap-command @@ -483,7 +485,7 @@ external if displayed external." (unwind-protect (start-process "*display*" (setq buffer - (generate-new-buffer "*mm*")) + (generate-new-buffer " *mm*")) shell-file-name shell-command-switch (mm-mailcap-command @@ -518,7 +520,7 @@ external if displayed external." (push "<" out) (push (mm-quote-arg file) out))) (mapconcat 'identity (nreverse out) ""))) - + (defun mm-remove-parts (handles) "Remove the displayed MIME parts represented by HANDLES." (if (and (listp handles) diff --git a/lisp/mm-extern.el b/lisp/mm-extern.el new file mode 100644 index 000000000..847954a08 --- /dev/null +++ b/lisp/mm-extern.el @@ -0,0 +1,114 @@ +;;; mm-extern.el --- showing message/external-body +;; Copyright (C) 2000 Free Software Foundation, Inc. + +;; Author: Shenghuo Zhu +;; Keywords: message external-body + +;; This file is part of GNU Emacs. + +;; 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) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;;; Code: + +(eval-when-compile + (require 'cl)) + +(require 'mm-util) +(require 'mm-decode) + +(defvar mm-extern-function-alist + '((local-file . mm-extern-local-file) + (url . mm-extern-url) +;;; (ftp . mm-extern-ftp) +;;; (anon-ftp . mm-extern-anon-ftp) +;;; (tftp . mm-extern-tftp) +;;; (mail-server . mm-extern-mail-server)) + )) + +(defun mm-extern-local-file (handle) + (let ((name (cdr (assq 'name (cdr (mm-handle-type handle))))) + (coding-system-for-read mm-binary-coding-system)) + (mm-disable-multibyte-mule4) + (mm-insert-file-contents name nil nil nil nil t))) + +(defun mm-extern-url (handle) + (require 'url) + (let ((url (cdr (assq 'url (cdr (mm-handle-type handle))))) + (name buffer-file-name) + (coding-system-for-read mm-binary-coding-system)) + (unless url + (error "URL is not specified")) + (mm-with-unibyte-current-buffer-mule4 + (url-insert-file-contents url)) + (mm-disable-multibyte-mule4) + (setq buffer-file-name name))) + +;;;###autoload +(defun mm-inline-external-body (handle &optional no-display) + "Show the external-body part of HANDLE. +This function replaces the buffer of HANDLE with a buffer contains +the entire message. +If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." + (let* ((access-type (cdr (assq 'access-type + (cdr (mm-handle-type handle))))) + (func (cdr (assq (intern access-type) mm-extern-function-alist))) + gnus-displaying-mime buf + handles) + (unless (mm-handle-cache handle) + (unless func + (error (format "Access type (%s) is not supported." access-type))) + (with-temp-buffer + (mm-insert-part handle) + (goto-char (point-max)) + (insert "\n\n") + (setq handles (mm-dissect-buffer t))) + (unless (bufferp (car handles)) + (mm-destroy-parts handles) + (error "Multipart external body is not supported.")) + (save-excursion ;; single part + (kill-buffer (mm-handle-buffer handles)) + (set-buffer (setq buf (generate-new-buffer " *mm*"))) + (condition-case err + (funcall func handle) + (error + ;; Don't require gnus-util + (when (gnus-buffer-exists-p buf) + (kill-buffer buf)) + (error err))) + (setcar handles (current-buffer)) + (mm-handle-set-cache handle handles)) + (push handles gnus-article-mime-handles)) + (unless no-display + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + (gnus-display-mime (mm-handle-cache handle)) + (mm-handle-set-undisplayer + handle + `(lambda () + (let (buffer-read-only) + (condition-case nil + ;; This is only valid on XEmacs. + (mapcar (lambda (prop) + (remove-specifier + (face-property 'default prop) (current-buffer))) + '(background background-pixmap foreground)) + (error nil)) + (delete-region ,(point-min-marker) ,(point-max-marker)))))))))) + +;; mm-extern.el ends here diff --git a/lisp/mm-partial.el b/lisp/mm-partial.el index 27189c937..734b2a0b9 100644 --- a/lisp/mm-partial.el +++ b/lisp/mm-partial.el @@ -88,7 +88,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing." (list gnus-article-mime-handles)) phandles)) (save-excursion - (set-buffer (generate-new-buffer "*mm*")) + (set-buffer (generate-new-buffer " *mm*")) (while (setq phandle (pop phandles)) (setq nn (string-to-number (cdr (assq 'number -- 2.25.1