[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-mime.el [emacs-unicode-2]
From: |
Miles Bader |
Subject: |
[Emacs-diffs] Changes to emacs/lisp/mh-e/mh-mime.el [emacs-unicode-2] |
Date: |
Fri, 27 Aug 2004 07:27:02 -0400 |
Index: emacs/lisp/mh-e/mh-mime.el
diff -c emacs/lisp/mh-e/mh-mime.el:1.3.4.2 emacs/lisp/mh-e/mh-mime.el:1.3.4.3
*** emacs/lisp/mh-e/mh-mime.el:1.3.4.2 Sat Jul 17 02:46:42 2004
--- emacs/lisp/mh-e/mh-mime.el Fri Aug 27 07:00:23 2004
***************
*** 34,40 ****
;;; Code:
! (require 'mh-utils)
(mh-require-cl)
(require 'mh-comp)
(require 'gnus-util)
--- 34,40 ----
;;; Code:
! (eval-when-compile (require 'mh-acros))
(mh-require-cl)
(require 'mh-comp)
(require 'gnus-util)
***************
*** 46,53 ****
(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")
--- 46,52 ----
(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")
***************
*** 82,88 ****
(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)
--- 81,87 ----
(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)
***************
*** 114,119 ****
--- 113,119 ----
;; 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."
***************
*** 129,135 ****
(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.
--- 129,136 ----
(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.
***************
*** 151,156 ****
--- 152,158 ----
(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."
***************
*** 192,203 ****
("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.
--- 194,231 ----
("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.
***************
*** 286,292 ****
"type=tar; conversions=x-compress"
"mode=image"))
!
(defun mh-mhn-compose-external-type (access-type host filename type
&optional description
attributes extra-params
--- 314,320 ----
"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
***************
*** 301,306 ****
--- 329,346 ----
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
***************
*** 314,320 ****
(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"))
--- 354,362 ----
(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"))
***************
*** 332,338 ****
(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)
--- 374,380 ----
(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)
***************
*** 349,355 ****
(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"))
--- 391,397 ----
(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"))
***************
*** 380,389 ****
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
--- 422,432 ----
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
***************
*** 393,398 ****
--- 436,454 ----
(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.
***************
*** 422,439 ****
(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)))
--- 478,501 ----
(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)))
***************
*** 450,463 ****
(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)
--- 512,534 ----
(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)
***************
*** 473,478 ****
--- 544,562 ----
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.
***************
*** 499,520 ****
(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 ()
--- 583,640 ----
(mml-insert-empty-tag 'part 'type type 'filename file
'disposition dispos 'description description)))
! (defvar mh-identity-pgg-default-user-id)
!
! (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 ()
***************
*** 667,685 ****
(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)
--- 787,805 ----
(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)
***************
*** 689,695 ****
(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
--- 809,815 ----
(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
***************
*** 732,737 ****
--- 852,865 ----
(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
***************
*** 766,782 ****
(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))
--- 894,911 ----
(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))
***************
*** 874,880 ****
(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."
--- 1003,1009 ----
(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."
***************
*** 904,910 ****
(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)
--- 1033,1040 ----
(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)
***************
*** 912,917 ****
--- 1042,1069 ----
(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))
***************
*** 954,960 ****
: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
--- 1106,1114 ----
: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
***************
*** 1009,1015 ****
(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))
--- 1163,1170 ----
(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))
***************
*** 1098,1103 ****
--- 1253,1283 ----
(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."
***************
*** 1106,1114 ****
(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")
--- 1286,1294 ----
(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")
***************
*** 1116,1124 ****
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
--- 1296,1302 ----
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
***************
*** 1149,1156 ****
(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.
--- 1327,1348 ----
(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.
***************
*** 1191,1196 ****
--- 1383,1390 ----
: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"))
***************
*** 1204,1211 ****
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)
--- 1398,1405 ----
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)
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] Changes to emacs/lisp/mh-e/mh-mime.el [emacs-unicode-2],
Miles Bader <=