emacs: lisp/mh-e/mh-mime.el comparison

comparison lisp/mh-e/mh-mime.el @ 89966:d8411455de48

Revision: miles@gnu.org--gnu-2004/emacs--unicode--0--patch-32 Merge from emacs--cvs-trunk--0 Patches applied: * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-486 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-487 Tweak permissions * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-488 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-489 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-490 Update from CVS: man/fixit.texi (Spelling): Fix typo. * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-491 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-494 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-495 Update from CVS: Add missing lisp/mh-e files * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-496 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-499 Update from CVS * miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-500 - miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-513 Update from CVS

author	Miles Bader <miles@gnu.org>
date	Fri, 27 Aug 2004 07:00:34 +0000
parents	97905c4f1a42 25da1d331c99
children	4da4a09e8b1b

comparison

equal deleted inserted replaced

-:5e9097d1ad99
+:d8411455de48
 ;;; Change Log:
 ;;; Code:
-(require 'mh-utils)
+(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-secure-message-sign-pgpmime "mml-sec")
+(autoload 'mml-unsecure-message "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
+(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"))
+("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/xml")
+("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))
-(insert "; directory=\"" (file-name-directory 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 mh-sent-from-msg
+(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 mh-sent-from-msg
+(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-nmh-flag
+((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 ()
+(defun mh-mhn-directive-present-p (&optional begin end)
-"Check if the current buffer has text which might be a MHN directive."
+"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 (point-min))
+(goto-char begin)
-(while (re-search-forward "^#" nil t)
+(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 (string-match mh-media-type-regexp first-token)
+(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))
-(mml-to-mime))
+(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 (equal message "")
+(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)))
-;;;###mh-autoload
+(defvar mh-identity-pgg-default-user-id)
-(defun mh-mml-secure-message-sign-pgpmime ()
-"Add directive to encrypt/sign the entire message."
+(defun mh-secure-message (method mode &optional identity)
-(interactive)
+"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")
-(mml-secure-message-sign-pgpmime)))
+;; Check the arguments
+(let ((valid-methods (list "pgpmime" "pgp" "smime"))
-;;;###mh-autoload
+(valid-modes (list "sign" "encrypt" "signencrypt" "none")))
-(defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)
+(if (not (member method valid-methods))
-"Add directive to encrypt and sign the entire message.
+(error (format "Sorry. METHOD \"%s\" is invalid." method)))
-If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."
+(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-secure-message-encrypt-pgpmime dontsign)))
+(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-nmh-flag "mhstore" "mhn"))
+(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 what directory? " nil nil t nil))
+(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 what directory? [%s] "
+"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.")
+(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)
 (and cte (intern (downcase
 (gnus-strip-whitespace cte))))
 (car ct))))))
 ;;;###mh-autoload
+(defun mh-toggle-mh-decode-mime-flag ()
+"Toggle whether MH-E should decode MIME or not."
+(interactive)
+(setq mh-decode-mime-flag (not mh-decode-mime-flag))
+(mh-show nil t)
+(message (format "(setq mh-decode-mime-flag %s)" mh-decode-mime-flag)))
+;;;###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)))))
 (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
+(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)))
+(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 (re-search-forward "^-- $" nil t)))))))
+(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)))
+(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")))
+"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-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."
-(insert "\n")
 (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
+handle 'mh-region (cons (point-min-marker) (point-max-marker)))))
-(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)
+(if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
-(mh-mime-security-show-details handle)))
+(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-headers)
+(invisible-headers mh-invisible-header-fields-compiled)
-(visible-headers mh-visible-headers))
+(visible-headers nil))
 (save-excursion
 (save-restriction
 (narrow-to-region b b)
 (mm-insert-part handle)
 (mh-mime-display

Mercurial > emacs

comparison lisp/mh-e/mh-mime.el @ 89966:d8411455de48