emacs-diffs
[Top][All Lists]
Advanced

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




reply via email to

[Prev in Thread] Current Thread [Next in Thread]