comparison lisp/mh-e/mh-mime.el @ 50702:7dd3d5eae9c7

Upgraded to MH-E version 7.3. See etc/MH-E-NEWS and lisp/mh-e/ChangeLog for details.

50701:cb5f0a5d5b36

;;; mh-mime.el --- MH-E support for composing MIME messages

;; Copyright (C) 1993, 1995, 2001, 2002 Free Software Foundation, Inc.

;; Author: Bill Wohler <[e-mail]>
;; Maintainer: Bill Wohler <[e-mail]>
;; Keywords: mail
;; See: mh-e.el

;; Internal support for MH-E package.
;; Support for generating an mhn composition file.
;; MIME is supported only by MH 6.8 or later.

;;; Change Log:

;; $Id: mh-mime.el,v 1.100 2003/01/25 19:18:51 satyaki Exp $

;;; Code:

(require 'cl)
(require 'mh-comp)

(autoload 'mml-minibuffer-read-file "mml")
(autoload 'mml-minibuffer-read-description "mml")
(autoload 'mml-insert-empty-tag "mml")
(autoload 'mml-to-mime "mml")
(autoload 'mml-attach-file "mml")

;;;###mh-autoload
(defun mh-compose-insertion (&optional inline)
  "Add a directive to insert a MIME part from a file, using mhn or gnus.
If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.

  "Insert a mhn directive to insert a file.

The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
used as the Content-Description field, optional set of ATTRIBUTES and an
optional COMMENT can also be included."
  (setq mh-mhn-compose-insert-flag t)
  (beginning-of-line)
  (insert "#" type)
  (and attributes
       (insert "; " attributes))
  (and comment

file and TYPE which is the MIME Content-Type. Optional arguments include
DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
EXTRA-PARAMS, and COMMENT.

See also \\[mh-edit-mhn]."
  (setq mh-mhn-compose-insert-flag t)
  (beginning-of-line)
  (insert "#@" type)
  (and attributes
       (insert "; " attributes))
  (and comment

                (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
                (read-string (format "Messages%s: "
                                     (if mh-sent-from-msg
                                         (format " [%d]" mh-sent-from-msg)
                                       "")))))
  (setq mh-mhn-compose-insert-flag t)
  (beginning-of-line)
  (insert "#forw [")
  (and description
       (not (string= description ""))
       (insert description))

Process the current draft with the mhn program, which, using directives
already inserted in the draft, fills in all the MIME components and header
fields.

This step should be done last just before sending the message.

The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
list `mh-mhn-args' are passed to mhn if this function is passed an optional
prefix argument EXTRA-ARGS.

For assistance with creating mhn directives to insert various types of
components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
message). If these helper functions are used, `mh-edit-mhn' is run
automatically when the draft is sent.

The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
arguments, after performing the conversion.

The mhn program is part of MH version 6.8 or later."

    (mh-exec-cmd-error nil
                       "mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
   (t
    (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
                       "mhn" (if extra-args mh-mhn-args) buffer-file-name)))
  (setq mh-mhn-compose-insert-flag nil)
  (revert-buffer t t)
  (message "mhn editing...done")
  (run-hooks 'mh-edit-mhn-hook))

;;;###mh-autoload

    (let ((buffer-read-only nil))
      (erase-buffer)
      (insert-file-contents backup-file))
    (after-find-file nil)))



;;; MIME composition functions

;;;###mh-autoload
(defun mh-mml-to-mime ()
  "Compose MIME message from mml directives."
  (interactive)
  (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
    (message-options-set-recipient))
  (mml-to-mime)
  (setq mh-mml-compose-insert-flag nil))

;;;###mh-autoload
(defun mh-mml-forward-message (description folder message)
  "Forward a message as attachment.
The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE

                                        mh-user-path (substring folder 1) msg)
                                "message/rfc822")
             (mml-attach-file (format "%s%s/%d"
                                      mh-user-path (substring folder 1) msg)
                              "message/rfc822"
                              description))
           (setq mh-mml-compose-insert-flag t))
          (t (error "The message number, %s is not a integer!" msg)))))

;;;###mh-autoload
(defun mh-mml-attach-file (&optional disposition)
  "Attach a file to the outgoing MIME message.

                     (completing-read "Disposition: [attachment] "
                                      '(("attachment")("inline"))
                                      nil t nil nil
                                      "attachment"))))
    (mml-insert-empty-tag 'part 'type type 'filename file
                          'disposition dispos 'description description)
    (setq mh-mml-compose-insert-flag t)))

;;;###mh-autoload
(defun mh-mml-secure-message-sign-pgpmime ()
  "Add directive to encrypt/sign the entire message."
  (interactive)
  (if (not mh-gnus-pgp-support-flag)
      (error "Sorry.  Your version of gnus does not support PGP/GPG")
    (mml-secure-message-sign-pgpmime)
    (setq mh-mml-compose-insert-flag t)))

;;;###mh-autoload
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
  "Add directive to encrypt and sign the entire message.
If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
  (interactive "P")
  (if (not mh-gnus-pgp-support-flag)
      (error "Sorry.  Your version of gnus does not support PGP/GPG")
    (mml-secure-message-encrypt-pgpmime dontsign)
    (setq mh-mml-compose-insert-flag t)))



;;; MIME decoding

                         (car handle))))

;; Copy of original macro is in mm-decode.el
(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
  (get-text-property 0 parameter (car handle)))

;; Copy of original function in mm-decode.el
(mh-defun-compat mm-readable-p (handle)
  "Say whether the content of HANDLE is readable."
  (and (< (with-current-buffer (mm-handle-buffer handle)

;;;###mh-autoload
(defun mh-mime-cleanup ()
  "Free the decoded MIME parts."
  (let ((mime-data (gethash (current-buffer) mh-globals-hash)))
    ;; This is for Emacs, what about XEmacs?
    (cond ((fboundp 'remove-images)
           (remove-images (point-min) (point-max))))
    (when mime-data
      (mm-destroy-parts (mh-mime-handles mime-data))
      (remhash (current-buffer) mh-globals-hash))))

;;;###mh-autoload

(defun mh-display-smileys ()
  "Function to display smileys."
  (when (and mh-graphical-smileys-flag
             (fboundp 'smiley-region)
             (boundp 'font-lock-maximum-size)
             (>= (/ font-lock-maximum-size 8) (buffer-size)))
    (smiley-region (point-min) (point-max))))

;;;###mh-autoload
(defun mh-display-emphasis ()
  "Function to display graphical emphasis."
  (when (and mh-graphical-emphasis-flag
             (boundp 'font-lock-maximum-size)
             (>= (/ font-lock-maximum-size 8) (buffer-size)))
    (flet ((article-goto-body ()))      ; shadow this function to do nothing
      (save-excursion
        (goto-char (point-min))
        (article-emphasize)))))

(defvar mh-mime-button-map
  (let ((map (make-sparse-keymap)))
    (unless (>= (string-to-number emacs-version) 21)
      ;; XEmacs doesn't care.
      (set-keymap-parent map mh-show-mode-map))
    (define-key map [mouse-2] 'mh-push-button)
    (dolist (c mh-mime-button-commands)
      (define-key map (cadr c) (car c)))
    map))
(defvar mh-mime-button-line-format-alist
  '((?T long-type ?s)

(defvar mh-mime-security-button-map
  (let ((map (make-sparse-keymap)))
    (unless (>= (string-to-number emacs-version) 21)
      (set-keymap-parent map mh-show-mode-map))
    (define-key map "\r" 'mh-press-button)
    (define-key map [mouse-2] 'mh-push-button)
    map))

(defvar mh-mime-save-parts-directory nil
  "Default to use for `mh-mime-save-parts-default-directory'.
Set from last use.")

    (if (not (file-directory-p directory))
        (message "No directory specified.")
      (if (equal nil mh-mime-save-parts-default-directory)
          (setq mh-mime-save-parts-directory directory))
      (save-excursion
        (set-buffer (get-buffer-create " *mh-store*"))
        (cd directory)
        (setq mh-mime-save-parts-directory directory)
        (erase-buffer)
        (apply 'call-process
               (expand-file-name command mh-progs) nil t nil
               (mh-list-to-string (list folder msg "-auto")))
        (if (> (buffer-size) 0)
            (save-window-excursion
              (switch-to-buffer-other-window " *mh-store*")
              (sit-for 3)))))))

;; Avoid errors if gnus-sum isn't loaded yet...
(defvar gnus-newsgroup-charset nil)
(defvar gnus-newsgroup-name nil)

;;;###mh-autoload
(defun mh-mime-display (&optional pre-dissected-handles)
  "Display (and possibly decode) MIME handles.
Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
present they are displayed otherwise the buffer is parsed and then
displayed."
  (let ((handles ())
        (folder mh-show-folder-buffer))
    (flet ((mm-handle-set-external-undisplayer
            (handle function)
            (mh-handle-set-external-undisplayer folder handle function)))
      ;; If needed dissect the current buffer
      (if pre-dissected-handles
          (setq handles pre-dissected-handles)
        (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
        (setf (mh-mime-handles (mh-buffer-data))
              (mm-merge-handles handles (mh-mime-handles (mh-buffer-data))))

        ;; Use charset to decode body...
        (unless handles
          (let* ((ct (ignore-errors
                       (mail-header-parse-content-type
                        (message-fetch-field "Content-Type" t))))
                 (charset (mail-content-type-get ct 'charset)))
            (when (stringp charset)
              (mm-decode-body charset)))))

      (when (and handles (or (not (stringp (car handles))) (cdr handles)))
        ;; Goto start of message body
        (goto-char (point-min))
        (or (search-forward "\n\n" nil t) (goto-char (point-max)))

        ;; Delete the body
        (delete-region (point) (point-max))

        ;; Display the MIME handles
        (mh-mime-display-part handles)))))

(defun mh-mime-display-part (handle)
  "Decides the viewer to call based on the type of HANDLE."
  (cond ((null handle) nil)
        ((not (stringp (car handle)))

                                        ; this only tells us if the image is
                                        ; something that emacs can display
         (let* ((image (mm-get-image handle)))
           (cond ((fboundp 'glyph-width)
                  ;; XEmacs -- totally untested, copied from gnus
                  (and (< (glyph-width image)
                          (or mh-max-inline-image-width
                              (window-pixel-width)))
                       (< (glyph-height image)
                          (or mh-max-inline-image-height
                              (window-pixel-height)))))
                 ((fboundp 'image-size)
                  ;; Emacs21 -- copied from gnus
                  (let ((size (image-size image)))
                    (and (< (cdr size)
                            (or mh-max-inline-image-height
                                (1- (window-height))))
                         (< (car size)
                            (or mh-max-inline-image-width (window-width))))))
                 (t

                  nil))))))

(defun mh-inline-vcard-p (handle)
  "Decide if HANDLE is a vcard that must be displayed inline."
  (let ((type (mm-handle-type handle)))
    (and (consp type)
         (equal (car type) "text/x-vcard")
         (save-excursion
           (save-restriction
             (widen)
             (goto-char (point-min))

             (insert "\n")
             (mh-insert-mime-button handle (mh-mime-part-index handle) nil)
             (forward-line -1)
             (mh-mm-display-part handle)))
      (goto-char (point-max)))))

(defun mh-insert-mime-button (handle index displayed)
  "Insert MIME button for HANDLE.
INDEX is the part number that will be DISPLAYED. It is also used by commands
like \"K v\" which operate on individual MIME parts."

            (if (mm-handle-displayed-p handle)
                ;; This will remove the part.
                (progn
                  ;; Delete the button and displayed part (if any)
                  (let ((region (get-text-property point 'mh-region)))
                    (when region
                      (when (fboundp 'remove-images)
                        (remove-images (car region) (cdr region))))
                    (mm-display-part handle)
                    (when region
                      (delete-region (car region) (cdr region))))
                  ;; Delete button (if it still remains). This happens for
                  ;; externally displayed parts where the previous step does

  "Click MIME button for EVENT.
If the MIME part is visible then it is removed. Otherwise the part is
displayed. This function is called when the mouse is used to click the MIME
button."
  (interactive "e")
  (set-buffer (window-buffer (posn-window (event-start event))))
  (select-window (posn-window (event-start event)))
  (let* ((pos (posn-point (event-start event)))
         (folder mh-show-folder-buffer)
         (mm-inline-media-tests mh-mm-inline-media-tests)
         (data (get-text-property pos 'mh-data))
         (function (get-text-property pos 'mh-callback))
         (buffer-read-only nil))
    (flet ((mm-handle-set-external-undisplayer
            (handle function)
            (mh-handle-set-external-undisplayer folder handle function)))
      (goto-char pos)
      (unwind-protect (and function (funcall function data))
        (set-buffer-modified-p nil)))))

;;;###mh-autoload
(defun mh-mime-save-part ()
  "Save MIME part at point."
  (interactive)

                           (mm-merge-handles
                            handles (mh-mime-handles (mh-buffer-data))))
                     handles))))

        (goto-char (point-min))
        (cond (clean-message-header
               (mh-clean-msg-header (point-min)
                                    invisible-headers
                                    visible-headers)
               (goto-char (point-min)))
              (t
               (mh-start-of-uncleaned-message)))
        (mh-show-xface)
        (mh-show-addr)
        ;; The other highlighting types don't need anything special
        (when (eq mh-highlight-citation-p 'gnus)
          (mh-gnus-article-highlight-citation))
        (goto-char (point-min))

50702:7dd3d5eae9c7

;;; mh-mime.el --- MH-E support for composing MIME messages

;; Copyright (C) 1993, 1995, 2001, 02, 2003 Free Software Foundation, Inc.

;; Author: Bill Wohler <[e-mail]>
;; Maintainer: Bill Wohler <[e-mail]>
;; Keywords: mail
;; See: mh-e.el

;; Internal support for MH-E package.
;; Support for generating an mhn composition file.
;; MIME is supported only by MH 6.8 or later.

;;; Change Log:

;;; Code:

(require 'cl)
(require 'mh-comp)

(autoload 'mml-minibuffer-read-file "mml")
(autoload 'mml-minibuffer-read-description "mml")
(autoload 'mml-insert-empty-tag "mml")
(autoload 'mml-to-mime "mml")
(autoload 'mml-attach-file "mml")
(autoload 'rfc2047-decode-region "rfc2047")

;;;###mh-autoload
(defun mh-compose-insertion (&optional inline)
  "Add a directive to insert a MIME part from a file, using mhn or gnus.
If the variable `mh-compose-insertion' is set to 'mhn, then that will be used.

  "Insert a mhn directive to insert a file.

The file specified by FILENAME is encoded as TYPE. An optional DESCRIPTION is
used as the Content-Description field, optional set of ATTRIBUTES and an
optional COMMENT can also be included."
  (beginning-of-line)
  (insert "#" type)
  (and attributes
       (insert "; " attributes))
  (and comment

file and TYPE which is the MIME Content-Type. Optional arguments include
DESCRIPTION, a line of text for the Content-description header, ATTRIBUTES,
EXTRA-PARAMS, and COMMENT.

See also \\[mh-edit-mhn]."
  (beginning-of-line)
  (insert "#@" type)
  (and attributes
       (insert "; " attributes))
  (and comment

                (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
                (read-string (format "Messages%s: "
                                     (if mh-sent-from-msg
                                         (format " [%d]" mh-sent-from-msg)
                                       "")))))
  (beginning-of-line)
  (insert "#forw [")
  (and description
       (not (string= description ""))
       (insert description))

Process the current draft with the mhn program, which, using directives
already inserted in the draft, fills in all the MIME components and header
fields.

This step is performed automatically when sending the message, but this
function may be called manually before sending the draft as well.

The `\\[mh-revert-mhn-edit]' command undoes this command. The arguments in the
list `mh-mhn-args' are passed to mhn if this function is passed an optional
prefix argument EXTRA-ARGS.

For assistance with creating mhn directives to insert various types of
components in a message, see \\[mh-mhn-compose-insertion] (generic insertion
from a file), \\[mh-mhn-compose-anon-ftp] (external reference to file via
anonymous ftp), \\[mh-mhn-compose-external-compressed-tar] \ \(reference to
compressed tar file via anonymous ftp), and \\[mh-mhn-compose-forw] (forward
message).

The value of `mh-edit-mhn-hook' is a list of functions to be called, with no
arguments, after performing the conversion.

The mhn program is part of MH version 6.8 or later."

    (mh-exec-cmd-error nil
                       "mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
   (t
    (mh-exec-cmd-error (format "mhdraft=%s" buffer-file-name)
                       "mhn" (if extra-args mh-mhn-args) buffer-file-name)))
  (revert-buffer t t)
  (message "mhn editing...done")
  (run-hooks 'mh-edit-mhn-hook))

;;;###mh-autoload

    (let ((buffer-read-only nil))
      (erase-buffer)
      (insert-file-contents backup-file))
    (after-find-file nil)))

;;;###mh-autoload
(defun mh-mhn-directive-present-p ()
  "Check if the current buffer has text which might be a MHN directive."
  (save-excursion
    (block 'search-for-mhn-directive
      (goto-char (point-min))
      (while (re-search-forward "^#" nil t)
        (let ((s (buffer-substring-no-properties (point) (line-end-position))))
          (cond ((equal s ""))
                ((string-match "^forw[ \t\n]+" s)
                 (return-from 'search-for-mhn-directive t))
                (t (let ((first-token (car (split-string s "[ \t;@]"))))
                     (when (string-match mh-media-type-regexp first-token)
                       (return-from 'search-for-mhn-directive t)))))))
      nil)))



;;; MIME composition functions

;;;###mh-autoload
(defun mh-mml-to-mime ()
  "Compose MIME message from mml directives.
This step is performed automatically when sending the message, but this
function may be called manually before sending the draft as well."
  (interactive)
  (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
    (message-options-set-recipient))
  (mml-to-mime))

;;;###mh-autoload
(defun mh-mml-forward-message (description folder message)
  "Forward a message as attachment.
The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE

                                        mh-user-path (substring folder 1) msg)
                                "message/rfc822")
             (mml-attach-file (format "%s%s/%d"
                                      mh-user-path (substring folder 1) msg)
                              "message/rfc822"
                              description)))
          (t (error "The message number, %s is not a integer!" msg)))))

;;;###mh-autoload
(defun mh-mml-attach-file (&optional disposition)
  "Attach a file to the outgoing MIME message.

                     (completing-read "Disposition: [attachment] "
                                      '(("attachment")("inline"))
                                      nil t nil nil
                                      "attachment"))))
    (mml-insert-empty-tag 'part 'type type 'filename file
                          'disposition dispos 'description description)))

;;;###mh-autoload
(defun mh-mml-secure-message-sign-pgpmime ()
  "Add directive to encrypt/sign the entire message."
  (interactive)
  (if (not mh-gnus-pgp-support-flag)
      (error "Sorry.  Your version of gnus does not support PGP/GPG")
    (mml-secure-message-sign-pgpmime)))

;;;###mh-autoload
(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
  "Add directive to encrypt and sign the entire message.
If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
  (interactive "P")
  (if (not mh-gnus-pgp-support-flag)
      (error "Sorry.  Your version of gnus does not support PGP/GPG")
    (mml-secure-message-encrypt-pgpmime dontsign)))

;;;###mh-autoload
(defun mh-mml-directive-present-p ()
  "Check if the current buffer has text which may be an MML directive."
  (save-excursion
    (goto-char (point-min))
    (re-search-forward
     "\\(<#part\\(.\\|\n\\)*>[ \n\t]*<#/part>\\|^<#secure.+>$\\)"
     nil t)))



;;; MIME decoding

                         (car handle))))

;; Copy of original macro is in mm-decode.el
(mh-defun-compat mm-handle-multipart-ctl-parameter (handle parameter)
  (get-text-property 0 parameter (car handle)))

(mh-do-in-xemacs (defvar default-enable-multibyte-characters))

;; Copy of original function in mm-decode.el
(mh-defun-compat mm-readable-p (handle)
  "Say whether the content of HANDLE is readable."
  (and (< (with-current-buffer (mm-handle-buffer handle)

;;;###mh-autoload
(defun mh-mime-cleanup ()
  "Free the decoded MIME parts."
  (let ((mime-data (gethash (current-buffer) mh-globals-hash)))
    ;; This is for Emacs, what about XEmacs?
    (mh-funcall-if-exists remove-images (point-min) (point-max))
    (when mime-data
      (mm-destroy-parts (mh-mime-handles mime-data))
      (remhash (current-buffer) mh-globals-hash))))

;;;###mh-autoload

(defun mh-display-smileys ()
  "Function to display smileys."
  (when (and mh-graphical-smileys-flag
             (fboundp 'smiley-region)
             (boundp 'font-lock-maximum-size)
             font-lock-maximum-size
             (>= (/ font-lock-maximum-size 8) (buffer-size)))
    (smiley-region (point-min) (point-max))))

;;;###mh-autoload
(defun mh-display-emphasis ()
  "Function to display graphical emphasis."
  (when (and mh-graphical-emphasis-flag
             (if font-lock-maximum-size
                 (>= (/ font-lock-maximum-size 8) (buffer-size))))
    (flet ((article-goto-body ()))      ; shadow this function to do nothing
      (save-excursion
        (goto-char (point-min))
        (article-emphasize)))))

(defvar mh-mime-button-map
  (let ((map (make-sparse-keymap)))
    (unless (>= (string-to-number emacs-version) 21)
      ;; XEmacs doesn't care.
      (set-keymap-parent map mh-show-mode-map))
    (mh-do-in-gnu-emacs
     (define-key map [mouse-2] 'mh-push-button))
    (mh-do-in-xemacs
     (define-key map '(button2) 'mh-push-button))
    (dolist (c mh-mime-button-commands)
      (define-key map (cadr c) (car c)))
    map))
(defvar mh-mime-button-line-format-alist
  '((?T long-type ?s)

(defvar mh-mime-security-button-map
  (let ((map (make-sparse-keymap)))
    (unless (>= (string-to-number emacs-version) 21)
      (set-keymap-parent map mh-show-mode-map))
    (define-key map "\r" 'mh-press-button)
    (mh-do-in-gnu-emacs
     (define-key map [mouse-2] 'mh-push-button))
    (mh-do-in-xemacs
     (define-key map '(button2) 'mh-push-button))
    map))

(defvar mh-mime-save-parts-directory nil
  "Default to use for `mh-mime-save-parts-default-directory'.
Set from last use.")

    (if (not (file-directory-p directory))
        (message "No directory specified.")
      (if (equal nil mh-mime-save-parts-default-directory)
          (setq mh-mime-save-parts-directory directory))
      (save-excursion
        (set-buffer (get-buffer-create mh-log-buffer))
        (cd directory)
        (setq mh-mime-save-parts-directory directory)
        (let ((initial-size (mh-truncate-log-buffer)))
          (apply 'call-process
                 (expand-file-name command mh-progs) nil t nil
                 (mh-list-to-string (list folder msg "-auto")))
          (if (> (buffer-size) initial-size)
              (save-window-excursion
                (switch-to-buffer-other-window mh-log-buffer)
                (sit-for 3))))))))

;; Avoid errors if gnus-sum isn't loaded yet...
(defvar gnus-newsgroup-charset nil)
(defvar gnus-newsgroup-name nil)

(defun mh-decode-message-body ()
  "Decode message based on charset.
If message has been encoded for transfer take that into account."
  (let* ((ct (ignore-errors (mail-header-parse-content-type
                             (message-fetch-field "Content-Type" t))))
         (charset (mail-content-type-get ct 'charset))
         (cte (message-fetch-field "Content-Transfer-Encoding")))
    (when (stringp cte) (setq cte (mail-header-strip cte)))
    (when (or (not ct) (equal (car ct) "text/plain"))
      (save-restriction
        (narrow-to-region (min (1+ (mh-mail-header-end)) (point-max))
                          (point-max))
        (mm-decode-body charset
                        (and cte (intern (downcase
                                          (gnus-strip-whitespace cte))))
                        (car ct))))))

;;;###mh-autoload
(defun mh-decode-message-header ()
  "Decode RFC2047 encoded message header fields."
  (when mh-decode-mime-flag
    (let ((buffer-read-only nil))
      (rfc2047-decode-region (point-min) (mh-mail-header-end)))))

;;;###mh-autoload
(defun mh-mime-display (&optional pre-dissected-handles)
  "Display (and possibly decode) MIME handles.
Optional argument, PRE-DISSECTED-HANDLES is a list of MIME handles. If
present they are displayed otherwise the buffer is parsed and then
displayed."
  (let ((handles ())
        (folder mh-show-folder-buffer)
        (raw-message-data (buffer-string)))
    (flet ((mm-handle-set-external-undisplayer
            (handle function)
            (mh-handle-set-external-undisplayer folder handle function)))
      (goto-char (point-min))
      (unless (search-forward "\n\n" nil t)
        (goto-char (point-max))
        (insert "\n\n"))

      (condition-case err
          (progn
            ;; If needed dissect the current buffer
            (if pre-dissected-handles
                (setq handles pre-dissected-handles)
              (setq handles (or (mm-dissect-buffer nil) (mm-uu-dissect)))
              (setf (mh-mime-handles (mh-buffer-data))
                    (mm-merge-handles handles
                                      (mh-mime-handles (mh-buffer-data))))
              (unless handles (mh-decode-message-body)))

            (when (and handles
                       (or (not (stringp (car handles))) (cdr handles)))
              ;; Goto start of message body
              (goto-char (point-min))
              (or (search-forward "\n\n" nil t) (goto-char (point-max)))

              ;; Delete the body
              (delete-region (point) (point-max))

              ;; Display the MIME handles
              (mh-mime-display-part handles)))
        (error
         (message "Please report this error. The error message is:\n %s"
                  (error-message-string err))
         (delete-region (point-min) (point-max))
         (insert raw-message-data))))))

(defun mh-mime-display-part (handle)
  "Decides the viewer to call based on the type of HANDLE."
  (cond ((null handle) nil)
        ((not (stringp (car handle)))

                                        ; this only tells us if the image is
                                        ; something that emacs can display
         (let* ((image (mm-get-image handle)))
           (cond ((fboundp 'glyph-width)
                  ;; XEmacs -- totally untested, copied from gnus
                  (and (mh-funcall-if-exists glyphp image)
                       (< (glyph-width image)
                          (or mh-max-inline-image-width
                              (window-pixel-width)))
                       (< (glyph-height image)
                          (or mh-max-inline-image-height
                              (window-pixel-height)))))
                 ((fboundp 'image-size)
                  ;; Emacs21 -- copied from gnus
                  (let ((size (mh-funcall-if-exists image-size image)))
                    (and size
                         (< (cdr size)
                            (or mh-max-inline-image-height
                                (1- (window-height))))
                         (< (car size)
                            (or mh-max-inline-image-width (window-width))))))
                 (t

                  nil))))))

(defun mh-inline-vcard-p (handle)
  "Decide if HANDLE is a vcard that must be displayed inline."
  (let ((type (mm-handle-type handle)))
    (and (or (featurep 'vcard) (fboundp 'vcard-pretty-print))
         (consp type)
         (equal (car type) "text/x-vcard")
         (save-excursion
           (save-restriction
             (widen)
             (goto-char (point-min))

             (insert "\n")
             (mh-insert-mime-button handle (mh-mime-part-index handle) nil)
             (forward-line -1)
             (mh-mm-display-part handle)))
      (goto-char (point-max)))))

(mh-do-in-xemacs
 (defvar dots)
 (defvar type))

(defun mh-insert-mime-button (handle index displayed)
  "Insert MIME button for HANDLE.
INDEX is the part number that will be DISPLAYED. It is also used by commands
like \"K v\" which operate on individual MIME parts."

            (if (mm-handle-displayed-p handle)
                ;; This will remove the part.
                (progn
                  ;; Delete the button and displayed part (if any)
                  (let ((region (get-text-property point 'mh-region)))
                    (when (and region (fboundp 'remove-images))
                      (mh-funcall-if-exists
                       remove-images (car region) (cdr region)))
                    (mm-display-part handle)
                    (when region
                      (delete-region (car region) (cdr region))))
                  ;; Delete button (if it still remains). This happens for
                  ;; externally displayed parts where the previous step does

  "Click MIME button for EVENT.
If the MIME part is visible then it is removed. Otherwise the part is
displayed. This function is called when the mouse is used to click the MIME
button."
  (interactive "e")
  (save-excursion
    (let* ((event-window
            (or (mh-funcall-if-exists posn-window (event-start event));GNU Emacs
                (mh-funcall-if-exists event-window event)))            ;XEmacs
           (event-position
            (or (mh-funcall-if-exists posn-point (event-start event)) ;GNU Emacs
                (mh-funcall-if-exists event-closest-point event)))    ;XEmacs
           (original-window (selected-window))
           (original-position (progn
                                (set-buffer (window-buffer event-window))
                                (set-marker (make-marker) (point))))
           (folder mh-show-folder-buffer)
           (mm-inline-media-tests mh-mm-inline-media-tests)
           (data (get-text-property event-position 'mh-data))
           (function (get-text-property event-position 'mh-callback))
           (buffer-read-only nil))
      (unwind-protect
          (progn
            (select-window event-window)
            (flet ((mm-handle-set-external-undisplayer (handle func)
                     (mh-handle-set-external-undisplayer folder handle func)))
              (goto-char event-position)
              (and function (funcall function data))))
        (set-buffer-modified-p nil)
        (goto-char original-position)
        (set-marker original-position nil)
        (select-window original-window)))))

;;;###mh-autoload
(defun mh-mime-save-part ()
  "Save MIME part at point."
  (interactive)

                           (mm-merge-handles
                            handles (mh-mime-handles (mh-buffer-data))))
                     handles))))

        (goto-char (point-min))
        (mh-show-xface)
        (cond (clean-message-header
               (mh-clean-msg-header (point-min)
                                    invisible-headers
                                    visible-headers)
               (goto-char (point-min)))
              (t
               (mh-start-of-uncleaned-message)))
        (mh-decode-message-header)
        (mh-show-addr)
        ;; The other highlighting types don't need anything special
        (when (eq mh-highlight-citation-p 'gnus)
          (mh-gnus-article-highlight-citation))
        (goto-char (point-min))