comparison lisp/mh-e/mh-mime.el @ 56673:e9a6cbc8ca5e

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

56672:83ab2b01744a

;;; Change Log:

;;; Code:

(require 'mh-utils)
(mh-require-cl)
(require 'mh-comp)
(require 'gnus-util)
(require 'mh-gnus)

(autoload 'article-emphasize "gnus-art")
(autoload 'gnus-get-buffer-create "gnus")
(autoload 'gnus-eval-format "gnus-spec")
(autoload 'widget-convert-button "wid-edit")
(autoload 'message-options-set-recipient "message")
(autoload 'mml-secure-message-sign-pgpmime "mml-sec")
(autoload 'mml-secure-message-encrypt-pgpmime "mml-sec")
(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")

If any of the optional arguments are absent, they are prompted for."
  (interactive (list
                (read-string "Forw Content-description: ")
                (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)
                                       "")))))
  (if (equal mh-compose-insertion 'gnus)
      (mh-mml-forward-message description folder message)
    (mh-mhn-compose-forw description folder message)))

;; Just defvar the variable to avoid compiler warning... This doesn't bind
;; the variable, so things should work exactly as before.
(defvar mh-have-file-command)

(defun mh-have-file-command ()
  "Return t if 'file' command is on the system.
'file -i' is used to get MIME type of composition insertion."
  (when (not (boundp 'mh-have-file-command))
    (load "executable" t t)        ; executable-find not autoloaded in emacs20

                                    (expand-file-name "inc" mh-progs))))))
  mh-have-file-command)

(defvar mh-file-mime-type-substitutions
  '(("application/msword" "\.xls" "application/ms-excel")
    ("application/msword" "\.ppt" "application/ms-powerpoint"))
  "Substitutions to make for Content-Type returned from file command.
The first element is the Content-Type returned by the file command.
The second element is a regexp matching the file name, usually the extension.
The third element is the Content-Type to replace with.")

          (setq answer (elt (car subst) 2)
                subst nil)
        (setq subst (cdr subst))))
    answer))

(defun mh-file-mime-type (filename)
  "Return MIME type of FILENAME from file command.
Returns nil if file command not on system."
  (cond
   ((not (mh-have-file-command))

    ("message/delivery-status")
    ("message/external-body") ("message/partial") ("message/rfc822")

    ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
    ("text/richtext") ("text/xml")

    ("video/mpeg") ("video/quicktime"))
  "Legal MIME content types.
See documentation for \\[mh-edit-mhn].")

;;;###mh-autoload
(defun mh-mhn-compose-insertion (filename type description attributes)
  "Add a directive to insert a MIME message part from a file.
This is the typical way to insert non-text parts in a message.

                                "application/octet-stream"
                                description
                                "type=tar; conversions=x-compress"
                                "mode=image"))


(defun mh-mhn-compose-external-type (access-type host filename type
                                                 &optional description
                                                 attributes extra-params
                                                 comment)
  "Add a directive to include a MIME reference to a remote file.

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

       (insert description))
  (insert "] ")
  (insert "access-type=" access-type "; ")
  (insert "site=" host)
  (insert "; name=" (file-name-nondirectory filename))
  (insert "; directory=\"" (file-name-directory filename) "\"")
  (and extra-params
       (insert "; " extra-params))
  (insert "\n"))

;;;###mh-autoload

See also \\[mh-edit-mhn]."
  (interactive (list
                (read-string "Forw Content-description: ")
                (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

  (if (and messages
           (not (string= messages "")))
      (let ((start (point)))
        (insert " " messages)
        (subst-char-in-region start (point) ?, ? ))
    (if mh-sent-from-msg
        (insert " " (int-to-string mh-sent-from-msg))))
  (insert "\n"))

;;;###mh-autoload
(defun mh-edit-mhn (&optional extra-args)

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."
  (interactive "*P")
  (save-buffer)
  (message "mhn editing...")
  (cond
   (mh-nmh-flag
    (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
(defun mh-revert-mhn-edit (noconfirm)
  "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
Optional non-nil argument NOCONFIRM means don't ask for confirmation."

      (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)))



function may be called manually before sending the draft as well."
  (interactive)
  (require 'message)
  (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
number."
  (let ((msg (if (equal message "")
                 mh-sent-from-msg
               (car (read-from-string message)))))
    (cond ((integerp msg)
           (if (string= "" description)
               ;; Rationale: mml-attach-file constructs a malformed composition

             (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.
The file is not inserted or encoded until you send the message with

                                      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

                 (mh-show-buffer-message-number)
               (mh-get-msg-num t)))
        (folder (if (eq major-mode 'mh-show-mode)
                    mh-show-folder-buffer
                  mh-current-folder))
        (command (if mh-nmh-flag "mhstore" "mhn"))
        (directory
         (cond
          ((and (or arg
                    (equal nil mh-mime-save-parts-default-directory)
                    (equal t mh-mime-save-parts-default-directory))
                (not mh-mime-save-parts-directory))
           (read-file-name "Store in what directory? " nil nil t nil))
          ((and (or arg
                    (equal t mh-mime-save-parts-default-directory))
                mh-mime-save-parts-directory)
           (read-file-name (format
                            "Store in what directory? [%s] "
                            mh-mime-save-parts-directory)
                           "" mh-mime-save-parts-directory t ""))
          ((stringp mh-mime-save-parts-default-directory)
           mh-mime-save-parts-default-directory)
          (t
           mh-mime-save-parts-directory))))
    (if (and (equal directory "") mh-mime-save-parts-directory)
        (setq directory mh-mime-save-parts-directory))
    (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)

              (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))))))

         (equal (car type) "text/x-vcard")
         (save-excursion
           (save-restriction
             (widen)
             (goto-char (point-min))
             (not (re-search-forward "^-- $" nil t)))))))

(defun mh-mime-display-single (handle)
  "Display a leaf node, HANDLE in the MIME tree."
  (let* ((type (mm-handle-media-type handle))
         (small-image-flag (mh-small-image-p handle))

             nil)             ; skip signatures as they are already handled...
            ((not displayp)
             (insert "\n")
             (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
            ((and displayp (not mh-display-buttons-for-inline-parts-flag))
             (or (mm-display-part handle) (mm-display-part handle)))
            ((and displayp mh-display-buttons-for-inline-parts-flag)
             (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))

     'link begin end
     :mime-handle handle
     :action 'mh-widget-press-button
     :button-keymap mh-mime-button-map
     :help-echo
     "Mouse-2 click or press RET (in show buffer) to toggle display")))

;; There is a bug in Gnus inline image display due to which an extra line
;; gets inserted every time it is viewed. To work around that problem we are
;; using an extra property 'mh-region to remember the region that is added
;; when the button is clicked. The region is then deleted to make sure that

                  (delete-char 1))
                (when (equal (mm-handle-media-supertype handle) "text")
                  (when (eq mh-highlight-citation-p 'gnus)
                    (mh-gnus-article-highlight-citation))
                  (mh-display-smileys)
                  (mh-display-emphasis))
                (setq region (cons (progn (goto-char (point-min))
                                          (point-marker))
                                   (progn (goto-char (point-max))
                                          (point-marker)))))))
        (when (window-live-p window)

           (mh-press-button)
           (message "MIME part already inserted")))
    (goto-char point)
    (set-buffer-modified-p nil)))

(defun mh-widget-press-button (widget el)
  "Callback for widget, WIDGET.
Parameter EL is unused."
  (goto-char (widget-get widget :from))
  (mh-press-button))

(defun mh-mime-display-security (handle)
  "Display PGP encrypted/signed message, HANDLE."
  (insert "\n")
  (save-restriction
    (narrow-to-region (point) (point))
    (mh-insert-mime-security-button handle)
    (mh-mime-display-mixed (cdr handle))
    (insert "\n")
    (let ((mh-mime-security-button-line-format
           mh-mime-security-button-end-line-format))
      (mh-insert-mime-security-button handle))
    (mm-set-handle-multipart-parameter
     handle 'mh-region
     (cons (set-marker (make-marker) (point-min))
           (set-marker (make-marker) (point-max))))))

;;; I rewrote the security part because Gnus doesn't seem to ever minimize
;;; the button. That is once the mime-security button is pressed there seems
;;; to be no way of getting rid of the inserted text.
(defun mh-mime-security-show-details (handle)

             (point-max)))
        (forward-line -1)))))

(defun mh-mime-security-press-button (handle)
  "Callback from security button for part HANDLE."
  (when (mm-handle-multipart-ctl-parameter handle 'gnus-info)
    (mh-mime-security-show-details handle)))

;; These variables should already be initialized in mm-decode.el if we have a
;; recent enough Gnus. The defvars are here to avoid compiler warnings.
(defvar mm-verify-function-alist nil)
(defvar mm-decrypt-function-alist nil)

    (widget-convert-button 'link begin end
                           :mime-handle handle
                           :action 'mh-widget-press-button
                           :button-keymap mh-mime-security-button-map
                           :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
    (when (equal info "Failed")
      (let* ((type (if (equal (car handle) "multipart/signed")
                       "verification" "decryption"))
             (warning (if (equal type "decryption")
                          "(passphrase may be incorrect)" "")))

  "Display message, HANDLE.
The function decodes the message and displays it. It avoids decoding the same
message multiple times."
  (let ((b (point))
        (clean-message-header mh-clean-message-header-flag)
        (invisible-headers mh-invisible-headers)
        (visible-headers mh-visible-headers))
    (save-excursion
      (save-restriction
        (narrow-to-region b b)
        (mm-insert-part handle)
        (mh-mime-display

56673:e9a6cbc8ca5e

;;; Change Log:

;;; Code:

(eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-comp)
(require 'gnus-util)
(require 'mh-gnus)

(autoload 'article-emphasize "gnus-art")
(autoload 'gnus-get-buffer-create "gnus")
(autoload 'gnus-eval-format "gnus-spec")
(autoload 'widget-convert-button "wid-edit")
(autoload 'message-options-set-recipient "message")
(autoload 'mml-unsecure-message "mml-sec")
(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")

If any of the optional arguments are absent, they are prompted for."
  (interactive (list
                (read-string "Forw Content-description: ")
                (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
                (read-string (format "Messages%s: "
                                     (if (numberp mh-sent-from-msg)
                                         (format " [%d]" mh-sent-from-msg)
                                       "")))))
  (if (equal mh-compose-insertion 'gnus)
      (mh-mml-forward-message description folder message)
    (mh-mhn-compose-forw description folder message)))

;; Just defvar the variable to avoid compiler warning... This doesn't bind
;; the variable, so things should work exactly as before.
(defvar mh-have-file-command)

;;;###mh-autoload
(defun mh-have-file-command ()
  "Return t if 'file' command is on the system.
'file -i' is used to get MIME type of composition insertion."
  (when (not (boundp 'mh-have-file-command))
    (load "executable" t t)        ; executable-find not autoloaded in emacs20

                                    (expand-file-name "inc" mh-progs))))))
  mh-have-file-command)

(defvar mh-file-mime-type-substitutions
  '(("application/msword" "\.xls" "application/ms-excel")
    ("application/msword" "\.ppt" "application/ms-powerpoint")
    ("text/plain" "\.vcf" "text/x-vcard"))
  "Substitutions to make for Content-Type returned from file command.
The first element is the Content-Type returned by the file command.
The second element is a regexp matching the file name, usually the extension.
The third element is the Content-Type to replace with.")

          (setq answer (elt (car subst) 2)
                subst nil)
        (setq subst (cdr subst))))
    answer))

;;;###mh-autoload
(defun mh-file-mime-type (filename)
  "Return MIME type of FILENAME from file command.
Returns nil if file command not on system."
  (cond
   ((not (mh-have-file-command))

    ("message/delivery-status")
    ("message/external-body") ("message/partial") ("message/rfc822")

    ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
    ("text/richtext") ("text/x-vcard") ("text/xml")

    ("video/mpeg") ("video/quicktime"))
  "Legal MIME content types.
See documentation for \\[mh-edit-mhn].")

;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One:
;;            Format of Internet Message Bodies.
;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two:
;;            Media Types.
;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five:
;;            Conformance Criteria and Examples.
;; RFC 2017 - Definition of the URL MIME External-Body Access-Type
;; RFC 1738 - Uniform Resource Locators (URL)
(defvar mh-access-types
  '(("anon-ftp")        ; RFC2046 Anonymous File Transfer Protocol
    ("file")            ; RFC1738 Host-specific file names
    ("ftp")             ; RFC2046 File Transfer Protocol
    ("gopher")          ; RFC1738 The Gopher Protocol
    ("http")            ; RFC1738 Hypertext Transfer Protocol
    ("local-file")      ; RFC2046 Local file access
    ("mail-server")     ; RFC2046 mail-server Electronic mail address
    ("mailto")          ; RFC1738 Electronic mail address
    ("news")            ; RFC1738 Usenet news
    ("nntp")            ; RFC1738 Usenet news using NNTP access
    ("propspero")       ; RFC1738 Prospero Directory Service
    ("telnet")          ; RFC1738 Telnet
    ("tftp")            ; RFC2046 Trivial File Transfer Protocol
    ("url")             ; RFC2017 URL scheme MIME access-type Protocol
    ("wais"))           ; RFC1738 Wide Area Information Servers
  "Legal MIME access-type values.")

;;;###mh-autoload
(defun mh-mhn-compose-insertion (filename type description attributes)
  "Add a directive to insert a MIME message part from a file.
This is the typical way to insert non-text parts in a message.

                                "application/octet-stream"
                                description
                                "type=tar; conversions=x-compress"
                                "mode=image"))

;;;###mh-autoload
(defun mh-mhn-compose-external-type (access-type host filename type
                                                 &optional description
                                                 attributes extra-params
                                                 comment)
  "Add a directive to include a MIME reference to a remote file.

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]."
  (interactive (list
                (completing-read "Access Type: " mh-access-types)
                (read-string "Remote host: ")
                (read-string "Remote url-path: ")
                (completing-read "Content-Type: "
                                 (if (fboundp 'mailcap-mime-types)
                                     (mapcar 'list (mailcap-mime-types))
                                   mh-mime-content-types))
                (if current-prefix-arg (read-string "Content-description: "))
                (if current-prefix-arg (read-string "Attributes: "))
                (if current-prefix-arg (read-string "Extra Parameters: "))
                (if current-prefix-arg (read-string "Comment: "))))
  (beginning-of-line)
  (insert "#@" type)
  (and attributes
       (insert "; " attributes))
  (and comment

       (insert description))
  (insert "] ")
  (insert "access-type=" access-type "; ")
  (insert "site=" host)
  (insert "; name=" (file-name-nondirectory filename))
  (let ((directory (file-name-directory filename)))
    (and directory
         (insert "; directory=\"" directory "\"")))
  (and extra-params
       (insert "; " extra-params))
  (insert "\n"))

;;;###mh-autoload

See also \\[mh-edit-mhn]."
  (interactive (list
                (read-string "Forw Content-description: ")
                (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
                (read-string (format "Messages%s: "
                                     (if (numberp mh-sent-from-msg)
                                         (format " [%d]" mh-sent-from-msg)
                                       "")))))
  (beginning-of-line)
  (insert "#forw [")
  (and description

  (if (and messages
           (not (string= messages "")))
      (let ((start (point)))
        (insert " " messages)
        (subst-char-in-region start (point) ?, ? ))
    (if (numberp mh-sent-from-msg)
        (insert " " (int-to-string mh-sent-from-msg))))
  (insert "\n"))

;;;###mh-autoload
(defun mh-edit-mhn (&optional extra-args)

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."
  (interactive "*P")
  (mh-mhn-quote-unescaped-sharp)
  (save-buffer)
  (message "mhn editing...")
  (cond
   ((mh-variant-p 'nmh)
    (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))

(defun mh-mhn-quote-unescaped-sharp ()
  "Quote `#' characters that haven't been quoted for `mhbuild'.
If the `#' character is present in the first column, but it isn't part of a
MHN directive then `mhbuild' gives an error. This function will quote all such
characters."
  (save-excursion
    (goto-char (point-min))
    (while (re-search-forward "^#" nil t)
      (beginning-of-line)
      (unless (mh-mhn-directive-present-p (point) (line-end-position))
        (insert "#"))
      (goto-char (line-end-position)))))

;;;###mh-autoload
(defun mh-revert-mhn-edit (noconfirm)
  "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
Optional non-nil argument NOCONFIRM means don't ask for confirmation."

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

;;;###mh-autoload
(defun mh-mhn-directive-present-p (&optional begin end)
  "Check if the text between BEGIN and END might be a MHN directive.
The optional argument BEGIN defaults to the beginning of the buffer, while END
defaults to the the end of the buffer."
  (unless begin (setq begin (point-min)))
  (unless end (setq end (point-max)))
  (save-excursion
    (block 'search-for-mhn-directive
      (goto-char begin)
      (while (re-search-forward "^#" end 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 (and first-token
                                (string-match mh-media-type-regexp
                                              first-token))
                       (return-from 'search-for-mhn-directive t)))))))
      nil)))



function may be called manually before sending the draft as well."
  (interactive)
  (require 'message)
  (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
    (message-options-set-recipient))
  (let ((saved-text (buffer-string))
        (buffer (current-buffer))
        (modified-flag (buffer-modified-p)))
    (condition-case err (mml-to-mime)
      (error
       (with-current-buffer buffer
         (delete-region (point-min) (point-max))
         (insert saved-text)
         (set-buffer-modified-p modified-flag))
       (error (error-message-string err))))))

;;;###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
number."
  (let ((msg (if (and (equal message "") (numberp mh-sent-from-msg))
                 mh-sent-from-msg
               (car (read-from-string message)))))
    (cond ((integerp msg)
           (if (string= "" description)
               ;; Rationale: mml-attach-file constructs a malformed composition

             (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)))))

(defvar mh-mml-cryptographic-method-history ())

;;;###mh-autoload
(defun mh-mml-query-cryptographic-method ()
  "Read the cryptographic method to use."
  (if current-prefix-arg
      (let ((def (or (car mh-mml-cryptographic-method-history)
                     mh-mml-method-default)))
        (completing-read (format "Method: [%s] " def)
                         '(("pgp") ("pgpmime") ("smime"))
                         nil t nil 'mh-mml-cryptographic-method-history def))
    mh-mml-method-default))

;;;###mh-autoload
(defun mh-mml-attach-file (&optional disposition)
  "Attach a file to the outgoing MIME message.
The file is not inserted or encoded until you send the message with

                                      nil t nil nil
                                      "attachment"))))
    (mml-insert-empty-tag 'part 'type type 'filename file
                          'disposition dispos 'description description)))

(defun mh-secure-message (method mode &optional identity)
  "Add directive to Encrypt/Sign an entire message.
METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\".
MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\".
IDENTITY is optionally the default-user-id to use."
  (if (not mh-gnus-pgp-support-flag)
      (error "Sorry.  Your version of gnus does not support PGP/GPG")
    ;; Check the arguments
    (let ((valid-methods (list "pgpmime" "pgp" "smime"))
          (valid-modes (list "sign" "encrypt" "signencrypt" "none")))
      (if (not (member method valid-methods))
          (error (format "Sorry. METHOD \"%s\" is invalid." method)))
      (if (not (member mode valid-modes))
          (error (format "Sorry. MODE \"%s\" is invalid" mode)))
      (mml-unsecure-message)
      (if (not (string= mode "none"))
        (save-excursion
          (goto-char (point-min))
          (mh-goto-header-end 1)
          (if mh-identity-pgg-default-user-id
              (mml-insert-tag 'secure 'method method 'mode mode
                              'sender mh-identity-pgg-default-user-id)
            (mml-insert-tag 'secure 'method method 'mode mode)))))))

;;;###mh-autoload
(defun mh-mml-unsecure-message (&optional ignore)
  "Remove any secure message directives.
The IGNORE argument is not used."
  (interactive "P")
  (if (not mh-gnus-pgp-support-flag)
      (error "Sorry.  Your version of gnus does not support PGP/GPG")
    (mml-unsecure-message)))

;;;###mh-autoload
(defun mh-mml-secure-message-sign (method)
  "Add security directive to sign the entire message using METHOD."
  (interactive (list (mh-mml-query-cryptographic-method)))
  (mh-secure-message method "sign" mh-identity-pgg-default-user-id))

;;;###mh-autoload
(defun mh-mml-secure-message-encrypt (method)
  "Add security directive to encrypt the entire message using METHOD."
  (interactive (list (mh-mml-query-cryptographic-method)))
  (mh-secure-message method "encrypt" mh-identity-pgg-default-user-id))

;;;###mh-autoload
(defun mh-mml-secure-message-signencrypt (method)
  "Add security directive to encrypt and sign the entire message using METHOD."
  (interactive (list (mh-mml-query-cryptographic-method)))
  (mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id))

;;;###mh-autoload
(defun mh-mml-directive-present-p ()
  "Check if the current buffer has text which may be an MML directive."
  (save-excursion

                 (mh-show-buffer-message-number)
               (mh-get-msg-num t)))
        (folder (if (eq major-mode 'mh-show-mode)
                    mh-show-folder-buffer
                  mh-current-folder))
        (command (if (mh-variant-p 'nmh) "mhstore" "mhn"))
        (directory
         (cond
          ((and (or arg
                    (equal nil mh-mime-save-parts-default-directory)
                    (equal t mh-mime-save-parts-default-directory))
                (not mh-mime-save-parts-directory))
           (read-file-name "Store in directory: " nil nil t nil))
          ((and (or arg
                    (equal t mh-mime-save-parts-default-directory))
                mh-mime-save-parts-directory)
           (read-file-name (format
                            "Store in directory: [%s] "
                            mh-mime-save-parts-directory)
                           "" mh-mime-save-parts-directory t ""))
          ((stringp mh-mime-save-parts-default-directory)
           mh-mime-save-parts-default-directory)
          (t
           mh-mime-save-parts-directory))))
    (if (and (equal directory "") mh-mime-save-parts-directory)
        (setq directory mh-mime-save-parts-directory))
    (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)

              (setf (mh-mime-handles (mh-buffer-data))
                    (mm-merge-handles handles
                                      (mh-mime-handles (mh-buffer-data))))
              (unless handles (mh-decode-message-body)))

            (cond ((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))
                  (t (mh-signature-highlight))))
        (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))))))

         (equal (car type) "text/x-vcard")
         (save-excursion
           (save-restriction
             (widen)
             (goto-char (point-min))
             (not (mh-signature-separator-p)))))))

(defun mh-mime-display-single (handle)
  "Display a leaf node, HANDLE in the MIME tree."
  (let* ((type (mm-handle-media-type handle))
         (small-image-flag (mh-small-image-p handle))

             nil)             ; skip signatures as they are already handled...
            ((not displayp)
             (insert "\n")
             (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
            ((and displayp (not mh-display-buttons-for-inline-parts-flag))
             (or (mm-display-part handle) (mm-display-part handle))
             (mh-signature-highlight handle))
            ((and displayp mh-display-buttons-for-inline-parts-flag)
             (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-signature-highlight (&optional handle)
  "Highlight message signature in HANDLE.
The optional argument, HANDLE is a MIME handle if the function is being used
to highlight the signature in a MIME part."
  (let ((regexp
         (cond ((not handle) "^-- $")
               ((not (and (equal (mm-handle-media-supertype handle) "text")
                          (equal (mm-handle-media-subtype handle) "html")))
                "^-- $")
               ((eq (mh-mm-text-html-renderer) 'lynx) "^   --$")
               (t "^--$"))))
    (save-excursion
      (goto-char (point-max))
      (when (re-search-backward regexp nil t)
        (mh-do-in-gnu-emacs
          (let ((ov (make-overlay (point) (point-max))))
            (overlay-put ov 'face 'mh-show-signature-face)
            (overlay-put ov 'evaporate t)))
        (mh-do-in-xemacs
          (set-extent-property (make-extent (point) (point-max))
                               'face 'mh-show-signature-face))))))

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

     'link begin end
     :mime-handle handle
     :action 'mh-widget-press-button
     :button-keymap mh-mime-button-map
     :help-echo
     "Mouse-2 click or press RET (in show buffer) to toggle display")
    (dolist (ov (mh-funcall-if-exists overlays-in begin end))
      (mh-funcall-if-exists overlay-put ov 'evaporate t))))

;; There is a bug in Gnus inline image display due to which an extra line
;; gets inserted every time it is viewed. To work around that problem we are
;; using an extra property 'mh-region to remember the region that is added
;; when the button is clicked. The region is then deleted to make sure that

                  (delete-char 1))
                (when (equal (mm-handle-media-supertype handle) "text")
                  (when (eq mh-highlight-citation-p 'gnus)
                    (mh-gnus-article-highlight-citation))
                  (mh-display-smileys)
                  (mh-display-emphasis)
                  (mh-signature-highlight handle))
                (setq region (cons (progn (goto-char (point-min))
                                          (point-marker))
                                   (progn (goto-char (point-max))
                                          (point-marker)))))))
        (when (window-live-p window)

           (mh-press-button)
           (message "MIME part already inserted")))
    (goto-char point)
    (set-buffer-modified-p nil)))

;;;###mh-autoload
(defun mh-display-with-external-viewer (part-index)
  "View MIME PART-INDEX externally."
  (interactive "P")
  (when (consp part-index) (setq part-index (car part-index)))
  (mh-folder-mime-action
   part-index
   #'(lambda ()
       (let* ((part (get-text-property (point) 'mh-data))
              (type (mm-handle-media-type part))
              (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
                               (mailcap-mime-info type 'all)))
              (def (caar methods))
              (prompt (format "Viewer: %s" (if def (format "[%s] " def) "")))
              (method (completing-read prompt methods nil nil nil nil def))
              (folder mh-show-folder-buffer)
              (buffer-read-only nil))
         (when (string-match "^[^% \t]+$" method)
           (setq method (concat method " %s")))
         (flet ((mm-handle-set-external-undisplayer (handle function)
                  (mh-handle-set-external-undisplayer folder handle function)))
           (unwind-protect (mm-display-external part method)
             (set-buffer-modified-p nil)))))
   nil))

(defun mh-widget-press-button (widget el)
  "Callback for widget, WIDGET.
Parameter EL is unused."
  (goto-char (widget-get widget :from))
  (mh-press-button))

(defun mh-mime-display-security (handle)
  "Display PGP encrypted/signed message, HANDLE."
  (save-restriction
    (narrow-to-region (point) (point))
    (insert "\n")
    (mh-insert-mime-security-button handle)
    (mh-mime-display-mixed (cdr handle))
    (insert "\n")
    (let ((mh-mime-security-button-line-format
           mh-mime-security-button-end-line-format))
      (mh-insert-mime-security-button handle))
    (mm-set-handle-multipart-parameter
     handle 'mh-region (cons (point-min-marker) (point-max-marker)))))

;;; I rewrote the security part because Gnus doesn't seem to ever minimize
;;; the button. That is once the mime-security button is pressed there seems
;;; to be no way of getting rid of the inserted text.
(defun mh-mime-security-show-details (handle)

             (point-max)))
        (forward-line -1)))))

(defun mh-mime-security-press-button (handle)
  "Callback from security button for part HANDLE."
  (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
      (mh-mime-security-show-details handle)
    (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region))
          point)
      (setq point (point))
      (goto-char (car region))
      (delete-region (car region) (cdr region))
      (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
        (let* ((mm-verify-option 'known)
               (mm-decrypt-option 'known)
               (new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
          (unless (eq new (cdr handle))
            (mm-destroy-parts (cdr handle))
            (setcdr handle new))))
      (mh-mime-display-security handle)
      (goto-char point))))

;; These variables should already be initialized in mm-decode.el if we have a
;; recent enough Gnus. The defvars are here to avoid compiler warnings.
(defvar mm-verify-function-alist nil)
(defvar mm-decrypt-function-alist nil)

    (widget-convert-button 'link begin end
                           :mime-handle handle
                           :action 'mh-widget-press-button
                           :button-keymap mh-mime-security-button-map
                           :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
    (dolist (ov (mh-funcall-if-exists overlays-in begin end))
      (mh-funcall-if-exists overlay-put ov 'evaporate t))
    (when (equal info "Failed")
      (let* ((type (if (equal (car handle) "multipart/signed")
                       "verification" "decryption"))
             (warning (if (equal type "decryption")
                          "(passphrase may be incorrect)" "")))

  "Display message, HANDLE.
The function decodes the message and displays it. It avoids decoding the same
message multiple times."
  (let ((b (point))
        (clean-message-header mh-clean-message-header-flag)
        (invisible-headers mh-invisible-header-fields-compiled)
        (visible-headers nil))
    (save-excursion
      (save-restriction
        (narrow-to-region b b)
        (mm-insert-part handle)
        (mh-mime-display