comparison lisp/gnus/mm-decode.el @ 91239:2fcaae6177a5

Merge from emacs--devo--0 Revision: [e-mail]/emacs--unicode--0--patch-300

91238:5cf14a2107b5

;;; Commentary:

;;; Code:

(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
(eval-when-compile (require 'cl)
		   (require 'term))

(eval-and-compile
  (autoload 'mm-inline-partial "mm-partial")

	      (if external
		  (mm-display-external
		   handle (or method 'mailcap-save-binary-file))
		(mm-display-external
		 handle 'mailcap-save-binary-file)))))))))

(defun mm-display-external (handle method)
  "Display HANDLE using METHOD."
  (let ((outbuf (current-buffer)))
    (mm-with-unibyte-buffer

    (let ((object (mm-handle-undisplayer handle)))
      (ignore-errors
	(cond
	 ;; Internally displayed part.
	 ((mm-annotationp object)
	  (delete-annotation object))
	 ((or (functionp object)
	      (and (listp object)
		   (eq (car object) 'lambda)))
	  (funcall object))
	 ;; Externally displayed part.

				  file)))
	 (progn
	   (mm-save-part-to-file handle file)
	   file))))

(defun mm-save-part-to-file (handle file)
  (mm-with-unibyte-buffer
    (mm-insert-part handle)
    (let ((current-file-modes (default-file-modes)))
      (set-default-file-modes mm-attachment-file-modes)
      (unwind-protect
	  ;; Don't re-compress .gz & al.  Arguably we should make
	  ;; `file-name-handler-alist' nil, but that would chop

  (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
	 (command
	  (read-string "Shell command on MIME part: " mm-last-shell-command)))
    (mm-with-unibyte-buffer
      (mm-insert-part handle)
      (let ((coding-system-for-write 'binary))
	(shell-command-on-region (point-min) (point-max) command nil)))))

(defun mm-interactively-view-part (handle)
  "Display HANDLE using METHOD."

(defsubst mm-set-handle-multipart-parameter (handle parameter value)
  ;; HANDLE could be a CTL.
  (when handle
    (put-text-property 0 (length (car handle)) parameter value
		       (car handle))))

(defun mm-possibly-verify-or-decrypt (parts ctl)
  (let ((type (car ctl))
	(subtype (cadr (split-string (car ctl) "/")))
	(mm-security-handle ctl) ;; (car CTL) is the type.

91239:2fcaae6177a5

;;; Commentary:

;;; Code:

;; For Emacs < 22.2.
(eval-and-compile
  (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))

(require 'mail-parse)
(require 'mailcap)
(require 'mm-bodies)
(require 'gnus-util)
(eval-when-compile (require 'cl)
		   (require 'term))

(eval-and-compile
  (autoload 'mm-inline-partial "mm-partial")

	      (if external
		  (mm-display-external
		   handle (or method 'mailcap-save-binary-file))
		(mm-display-external
		 handle 'mailcap-save-binary-file)))))))))

(declare-function gnus-configure-windows "gnus-win" (setting &optional force))

(defun mm-display-external (handle method)
  "Display HANDLE using METHOD."
  (let ((outbuf (current-buffer)))
    (mm-with-unibyte-buffer

    (let ((object (mm-handle-undisplayer handle)))
      (ignore-errors
	(cond
	 ;; Internally displayed part.
	 ((mm-annotationp object)
          (if (featurep 'xemacs)
              (delete-annotation object)))
	 ((or (functionp object)
	      (and (listp object)
		   (eq (car object) 'lambda)))
	  (funcall object))
	 ;; Externally displayed part.

				  file)))
	 (progn
	   (mm-save-part-to-file handle file)
	   file))))

(defun mm-add-meta-html-tag (handle &optional charset)
  "Add meta html tag to specify CHARSET of HANDLE in the current buffer.
CHARSET defaults to the one HANDLE specifies.  Existing meta tag that
specifies charset will not be modified.  Return t if meta tag is added
or replaced."
  (when (equal (mm-handle-media-type handle) "text/html")
    (when (or charset
	      (setq charset (mail-content-type-get (mm-handle-type handle)
						   'charset)))
      (setq charset (format "\
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\">" charset))
      (let ((case-fold-search t))
	(goto-char (point-min))
	(if (re-search-forward "\
<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']\
text/\\(\\sw+\\)\\(?:\;\\s-*charset=\\(.+?\\)\\)?[\"'][^>]*>" nil t)
	    (if (and (match-beginning 2)
		     (string-match "\\`html\\'" (match-string 1)))
		;; Don't modify existing meta tag.
		nil
	      ;; Replace it with the one specifying charset.
	      (replace-match charset)
	      t)
	  (if (re-search-forward "<head>\\s-*" nil t)
	      (insert charset "\n")
	    (re-search-forward "<html\\(?:\\s-+[^>]+\\|\\s-*\\)>\\s-*" nil t)
	    (insert "<head>\n" charset "\n</head>\n"))
	  t)))))

(defun mm-save-part-to-file (handle file)
  (mm-with-unibyte-buffer
    (mm-insert-part handle)
    (mm-add-meta-html-tag handle)
    (let ((current-file-modes (default-file-modes)))
      (set-default-file-modes mm-attachment-file-modes)
      (unwind-protect
	  ;; Don't re-compress .gz & al.  Arguably we should make
	  ;; `file-name-handler-alist' nil, but that would chop

  (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
	 (command
	  (read-string "Shell command on MIME part: " mm-last-shell-command)))
    (mm-with-unibyte-buffer
      (mm-insert-part handle)
      (mm-add-meta-html-tag handle)
      (let ((coding-system-for-write 'binary))
	(shell-command-on-region (point-min) (point-max) command nil)))))

(defun mm-interactively-view-part (handle)
  "Display HANDLE using METHOD."

(defsubst mm-set-handle-multipart-parameter (handle parameter value)
  ;; HANDLE could be a CTL.
  (when handle
    (put-text-property 0 (length (car handle)) parameter value
		       (car handle))))

(autoload 'mm-view-pkcs7 "mm-view")

(defun mm-possibly-verify-or-decrypt (parts ctl)
  (let ((type (car ctl))
	(subtype (cadr (split-string (car ctl) "/")))
	(mm-security-handle ctl) ;; (car CTL) is the type.