/[emacs]/emacs/lisp/mh-e/mh-mime.el
ViewVC logotype

Diff of /emacs/lisp/mh-e/mh-mime.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.5 by wohler, Tue Jul 13 03:06:24 2004 UTC revision 1.5.2.1 by miles, Sat Sep 4 12:01:04 2004 UTC
# Line 34  Line 34 
34    
35  ;;; Code:  ;;; Code:
36    
37  (require 'mh-utils)  (eval-when-compile (require 'mh-acros))
38  (mh-require-cl)  (mh-require-cl)
39  (require 'mh-comp)  (require 'mh-comp)
40  (require 'gnus-util)  (require 'gnus-util)
# Line 46  Line 46 
46  (autoload 'gnus-eval-format "gnus-spec")  (autoload 'gnus-eval-format "gnus-spec")
47  (autoload 'widget-convert-button "wid-edit")  (autoload 'widget-convert-button "wid-edit")
48  (autoload 'message-options-set-recipient "message")  (autoload 'message-options-set-recipient "message")
49  (autoload 'mml-secure-message-sign-pgpmime "mml-sec")  (autoload 'mml-unsecure-message "mml-sec")
 (autoload 'mml-secure-message-encrypt-pgpmime "mml-sec")  
50  (autoload 'mml-minibuffer-read-file "mml")  (autoload 'mml-minibuffer-read-file "mml")
51  (autoload 'mml-minibuffer-read-description "mml")  (autoload 'mml-minibuffer-read-description "mml")
52  (autoload 'mml-insert-empty-tag "mml")  (autoload 'mml-insert-empty-tag "mml")
# Line 82  If any of the optional arguments are abs Line 81  If any of the optional arguments are abs
81                  (read-string "Forw Content-description: ")                  (read-string "Forw Content-description: ")
82                  (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)                  (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
83                  (read-string (format "Messages%s: "                  (read-string (format "Messages%s: "
84                                       (if mh-sent-from-msg                                       (if (numberp mh-sent-from-msg)
85                                           (format " [%d]" mh-sent-from-msg)                                           (format " [%d]" mh-sent-from-msg)
86                                         "")))))                                         "")))))
87    (if (equal mh-compose-insertion 'gnus)    (if (equal mh-compose-insertion 'gnus)
# Line 114  MH profile.") Line 113  MH profile.")
113  ;; the variable, so things should work exactly as before.  ;; the variable, so things should work exactly as before.
114  (defvar mh-have-file-command)  (defvar mh-have-file-command)
115    
116    ;;;###mh-autoload
117  (defun mh-have-file-command ()  (defun mh-have-file-command ()
118    "Return t if 'file' command is on the system.    "Return t if 'file' command is on the system.
119  'file -i' is used to get MIME type of composition insertion."  'file -i' is used to get MIME type of composition insertion."
# Line 129  MH profile.") Line 129  MH profile.")
129    
130  (defvar mh-file-mime-type-substitutions  (defvar mh-file-mime-type-substitutions
131    '(("application/msword" "\.xls" "application/ms-excel")    '(("application/msword" "\.xls" "application/ms-excel")
132      ("application/msword" "\.ppt" "application/ms-powerpoint"))      ("application/msword" "\.ppt" "application/ms-powerpoint")
133        ("text/plain" "\.vcf" "text/x-vcard"))
134    "Substitutions to make for Content-Type returned from file command.    "Substitutions to make for Content-Type returned from file command.
135  The first element is the Content-Type returned by the file command.  The first element is the Content-Type returned by the file command.
136  The second element is a regexp matching the file name, usually the extension.  The second element is a regexp matching the file name, usually the extension.
# Line 151  Substitutions are made from the `mh-file Line 152  Substitutions are made from the `mh-file
152          (setq subst (cdr subst))))          (setq subst (cdr subst))))
153      answer))      answer))
154    
155    ;;;###mh-autoload
156  (defun mh-file-mime-type (filename)  (defun mh-file-mime-type (filename)
157    "Return MIME type of FILENAME from file command.    "Return MIME type of FILENAME from file command.
158  Returns nil if file command not on system."  Returns nil if file command not on system."
# Line 192  Returns nil if file command not on syste Line 194  Returns nil if file command not on syste
194      ("message/external-body") ("message/partial") ("message/rfc822")      ("message/external-body") ("message/partial") ("message/rfc822")
195    
196      ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")      ("text/enriched") ("text/html") ("text/plain") ("text/rfc822-headers")
197      ("text/richtext") ("text/xml")      ("text/richtext") ("text/x-vcard") ("text/xml")
198    
199      ("video/mpeg") ("video/quicktime"))      ("video/mpeg") ("video/quicktime"))
200    "Legal MIME content types.    "Legal MIME content types.
201  See documentation for \\[mh-edit-mhn].")  See documentation for \\[mh-edit-mhn].")
202    
203    ;; RFC 2045 - Multipurpose Internet Mail Extensions (MIME) Part One:
204    ;;            Format of Internet Message Bodies.
205    ;; RFC 2046 - Multipurpose Internet Mail Extensions (MIME) Part Two:
206    ;;            Media Types.
207    ;; RFC 2049 - Multipurpose Internet Mail Extensions (MIME) Part Five:
208    ;;            Conformance Criteria and Examples.
209    ;; RFC 2017 - Definition of the URL MIME External-Body Access-Type
210    ;; RFC 1738 - Uniform Resource Locators (URL)
211    (defvar mh-access-types
212      '(("anon-ftp")        ; RFC2046 Anonymous File Transfer Protocol
213        ("file")            ; RFC1738 Host-specific file names
214        ("ftp")             ; RFC2046 File Transfer Protocol
215        ("gopher")          ; RFC1738 The Gopher Protocol
216        ("http")            ; RFC1738 Hypertext Transfer Protocol
217        ("local-file")      ; RFC2046 Local file access
218        ("mail-server")     ; RFC2046 mail-server Electronic mail address
219        ("mailto")          ; RFC1738 Electronic mail address
220        ("news")            ; RFC1738 Usenet news
221        ("nntp")            ; RFC1738 Usenet news using NNTP access
222        ("propspero")       ; RFC1738 Prospero Directory Service
223        ("telnet")          ; RFC1738 Telnet
224        ("tftp")            ; RFC2046 Trivial File Transfer Protocol
225        ("url")             ; RFC2017 URL scheme MIME access-type Protocol
226        ("wais"))           ; RFC1738 Wide Area Information Servers
227      "Legal MIME access-type values.")
228    
229  ;;;###mh-autoload  ;;;###mh-autoload
230  (defun mh-mhn-compose-insertion (filename type description attributes)  (defun mh-mhn-compose-insertion (filename type description attributes)
231    "Add a directive to insert a MIME message part from a file.    "Add a directive to insert a MIME message part from a file.
# Line 286  See also \\[mh-edit-mhn]." Line 314  See also \\[mh-edit-mhn]."
314                                  "type=tar; conversions=x-compress"                                  "type=tar; conversions=x-compress"
315                                  "mode=image"))                                  "mode=image"))
316    
317    ;;;###mh-autoload
318  (defun mh-mhn-compose-external-type (access-type host filename type  (defun mh-mhn-compose-external-type (access-type host filename type
319                                                   &optional description                                                   &optional description
320                                                   attributes extra-params                                                   attributes extra-params
# Line 301  DESCRIPTION, a line of text for the Cont Line 329  DESCRIPTION, a line of text for the Cont
329  EXTRA-PARAMS, and COMMENT.  EXTRA-PARAMS, and COMMENT.
330    
331  See also \\[mh-edit-mhn]."  See also \\[mh-edit-mhn]."
332      (interactive (list
333                    (completing-read "Access Type: " mh-access-types)
334                    (read-string "Remote host: ")
335                    (read-string "Remote url-path: ")
336                    (completing-read "Content-Type: "
337                                     (if (fboundp 'mailcap-mime-types)
338                                         (mapcar 'list (mailcap-mime-types))
339                                       mh-mime-content-types))
340                    (if current-prefix-arg (read-string "Content-description: "))
341                    (if current-prefix-arg (read-string "Attributes: "))
342                    (if current-prefix-arg (read-string "Extra Parameters: "))
343                    (if current-prefix-arg (read-string "Comment: "))))
344    (beginning-of-line)    (beginning-of-line)
345    (insert "#@" type)    (insert "#@" type)
346    (and attributes    (and attributes
# Line 314  See also \\[mh-edit-mhn]." Line 354  See also \\[mh-edit-mhn]."
354    (insert "access-type=" access-type "; ")    (insert "access-type=" access-type "; ")
355    (insert "site=" host)    (insert "site=" host)
356    (insert "; name=" (file-name-nondirectory filename))    (insert "; name=" (file-name-nondirectory filename))
357    (insert "; directory=\"" (file-name-directory filename) "\"")    (let ((directory (file-name-directory filename)))
358        (and directory
359             (insert "; directory=\"" directory "\"")))
360    (and extra-params    (and extra-params
361         (insert "; " extra-params))         (insert "; " extra-params))
362    (insert "\n"))    (insert "\n"))
# Line 332  See also \\[mh-edit-mhn]." Line 374  See also \\[mh-edit-mhn]."
374                  (read-string "Forw Content-description: ")                  (read-string "Forw Content-description: ")
375                  (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)                  (mh-prompt-for-folder "Message from" mh-sent-from-folder nil)
376                  (read-string (format "Messages%s: "                  (read-string (format "Messages%s: "
377                                       (if mh-sent-from-msg                                       (if (numberp mh-sent-from-msg)
378                                           (format " [%d]" mh-sent-from-msg)                                           (format " [%d]" mh-sent-from-msg)
379                                         "")))))                                         "")))))
380    (beginning-of-line)    (beginning-of-line)
# Line 349  See also \\[mh-edit-mhn]." Line 391  See also \\[mh-edit-mhn]."
391        (let ((start (point)))        (let ((start (point)))
392          (insert " " messages)          (insert " " messages)
393          (subst-char-in-region start (point) ?, ? ))          (subst-char-in-region start (point) ?, ? ))
394      (if mh-sent-from-msg      (if (numberp mh-sent-from-msg)
395          (insert " " (int-to-string mh-sent-from-msg))))          (insert " " (int-to-string mh-sent-from-msg))))
396    (insert "\n"))    (insert "\n"))
397    
# Line 380  arguments, after performing the conversi Line 422  arguments, after performing the conversi
422    
423  The mhn program is part of MH version 6.8 or later."  The mhn program is part of MH version 6.8 or later."
424    (interactive "*P")    (interactive "*P")
425      (mh-mhn-quote-unescaped-sharp)
426    (save-buffer)    (save-buffer)
427    (message "mhn editing...")    (message "mhn editing...")
428    (cond    (cond
429     (mh-nmh-flag     ((mh-variant-p 'nmh)
430      (mh-exec-cmd-error nil      (mh-exec-cmd-error nil
431                         "mhbuild" (if extra-args mh-mhn-args) buffer-file-name))                         "mhbuild" (if extra-args mh-mhn-args) buffer-file-name))
432     (t     (t
# Line 393  The mhn program is part of MH version 6. Line 436  The mhn program is part of MH version 6.
436    (message "mhn editing...done")    (message "mhn editing...done")
437    (run-hooks 'mh-edit-mhn-hook))    (run-hooks 'mh-edit-mhn-hook))
438    
439    (defun mh-mhn-quote-unescaped-sharp ()
440      "Quote `#' characters that haven't been quoted for `mhbuild'.
441    If the `#' character is present in the first column, but it isn't part of a
442    MHN directive then `mhbuild' gives an error. This function will quote all such
443    characters."
444      (save-excursion
445        (goto-char (point-min))
446        (while (re-search-forward "^#" nil t)
447          (beginning-of-line)
448          (unless (mh-mhn-directive-present-p (point) (line-end-position))
449            (insert "#"))
450          (goto-char (line-end-position)))))
451    
452  ;;;###mh-autoload  ;;;###mh-autoload
453  (defun mh-revert-mhn-edit (noconfirm)  (defun mh-revert-mhn-edit (noconfirm)
454    "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.    "Undo the effect of \\[mh-edit-mhn] by reverting to the backup file.
# Line 422  Optional non-nil argument NOCONFIRM mean Line 478  Optional non-nil argument NOCONFIRM mean
478      (after-find-file nil)))      (after-find-file nil)))
479    
480  ;;;###mh-autoload  ;;;###mh-autoload
481  (defun mh-mhn-directive-present-p ()  (defun mh-mhn-directive-present-p (&optional begin end)
482    "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.
483    The optional argument BEGIN defaults to the beginning of the buffer, while END
484    defaults to the the end of the buffer."
485      (unless begin (setq begin (point-min)))
486      (unless end (setq end (point-max)))
487    (save-excursion    (save-excursion
488      (block 'search-for-mhn-directive      (block 'search-for-mhn-directive
489        (goto-char (point-min))        (goto-char begin)
490        (while (re-search-forward "^#" nil t)        (while (re-search-forward "^#" end t)
491          (let ((s (buffer-substring-no-properties (point) (line-end-position))))          (let ((s (buffer-substring-no-properties (point) (line-end-position))))
492            (cond ((equal s ""))            (cond ((equal s ""))
493                  ((string-match "^forw[ \t\n]+" s)                  ((string-match "^forw[ \t\n]+" s)
494                   (return-from 'search-for-mhn-directive t))                   (return-from 'search-for-mhn-directive t))
495                  (t (let ((first-token (car (split-string s "[ \t;@]"))))                  (t (let ((first-token (car (split-string s "[ \t;@]"))))
496                       (when (string-match mh-media-type-regexp first-token)                       (when (and first-token
497                                    (string-match mh-media-type-regexp
498                                                  first-token))
499                         (return-from 'search-for-mhn-directive t)))))))                         (return-from 'search-for-mhn-directive t)))))))
500        nil)))        nil)))
501    
# Line 450  function may be called manually before s Line 512  function may be called manually before s
512    (require 'message)    (require 'message)
513    (when mh-gnus-pgp-support-flag ;; This is only needed for PGP    (when mh-gnus-pgp-support-flag ;; This is only needed for PGP
514      (message-options-set-recipient))      (message-options-set-recipient))
515    (mml-to-mime))    (let ((saved-text (buffer-string))
516            (buffer (current-buffer))
517            (modified-flag (buffer-modified-p)))
518        (condition-case err (mml-to-mime)
519          (error
520           (with-current-buffer buffer
521             (delete-region (point-min) (point-max))
522             (insert saved-text)
523             (set-buffer-modified-p modified-flag))
524           (error (error-message-string err))))))
525    
526  ;;;###mh-autoload  ;;;###mh-autoload
527  (defun mh-mml-forward-message (description folder message)  (defun mh-mml-forward-message (description folder message)
528    "Forward a message as attachment.    "Forward a message as attachment.
529  The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE  The function will prompt the user for a DESCRIPTION, a FOLDER and MESSAGE
530  number."  number."
531    (let ((msg (if (equal message "")    (let ((msg (if (and (equal message "") (numberp mh-sent-from-msg))
532                   mh-sent-from-msg                   mh-sent-from-msg
533                 (car (read-from-string message)))))                 (car (read-from-string message)))))
534      (cond ((integerp msg)      (cond ((integerp msg)
# Line 473  number." Line 544  number."
544                                description)))                                description)))
545            (t (error "The message number, %s is not a integer!" msg)))))            (t (error "The message number, %s is not a integer!" msg)))))
546    
547    (defvar mh-mml-cryptographic-method-history ())
548    
549    ;;;###mh-autoload
550    (defun mh-mml-query-cryptographic-method ()
551      "Read the cryptographic method to use."
552      (if current-prefix-arg
553          (let ((def (or (car mh-mml-cryptographic-method-history)
554                         mh-mml-method-default)))
555            (completing-read (format "Method: [%s] " def)
556                             '(("pgp") ("pgpmime") ("smime"))
557                             nil t nil 'mh-mml-cryptographic-method-history def))
558        mh-mml-method-default))
559    
560  ;;;###mh-autoload  ;;;###mh-autoload
561  (defun mh-mml-attach-file (&optional disposition)  (defun mh-mml-attach-file (&optional disposition)
562    "Attach a file to the outgoing MIME message.    "Attach a file to the outgoing MIME message.
# Line 499  automatically." Line 583  automatically."
583      (mml-insert-empty-tag 'part 'type type 'filename file      (mml-insert-empty-tag 'part 'type type 'filename file
584                            'disposition dispos 'description description)))                            'disposition dispos 'description description)))
585    
586  ;;;###mh-autoload  (defvar mh-identity-pgg-default-user-id)
587  (defun mh-mml-secure-message-sign-pgpmime ()  
588    "Add directive to encrypt/sign the entire message."  (defun mh-secure-message (method mode &optional identity)
589    (interactive)    "Add directive to Encrypt/Sign an entire message.
590    METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\".
591    MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\".
592    IDENTITY is optionally the default-user-id to use."
593    (if (not mh-gnus-pgp-support-flag)    (if (not mh-gnus-pgp-support-flag)
594        (error "Sorry.  Your version of gnus does not support PGP/GPG")        (error "Sorry.  Your version of gnus does not support PGP/GPG")
595      (mml-secure-message-sign-pgpmime)))      ;; Check the arguments
596        (let ((valid-methods (list "pgpmime" "pgp" "smime"))
597              (valid-modes (list "sign" "encrypt" "signencrypt" "none")))
598          (if (not (member method valid-methods))
599              (error (format "Sorry. METHOD \"%s\" is invalid." method)))
600          (if (not (member mode valid-modes))
601              (error (format "Sorry. MODE \"%s\" is invalid" mode)))
602          (mml-unsecure-message)
603          (if (not (string= mode "none"))
604            (save-excursion
605              (goto-char (point-min))
606              (mh-goto-header-end 1)
607              (if mh-identity-pgg-default-user-id
608                  (mml-insert-tag 'secure 'method method 'mode mode
609                                  'sender mh-identity-pgg-default-user-id)
610                (mml-insert-tag 'secure 'method method 'mode mode)))))))
611    
612  ;;;###mh-autoload  ;;;###mh-autoload
613  (defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)  (defun mh-mml-unsecure-message (&optional ignore)
614    "Add directive to encrypt and sign the entire message.    "Remove any secure message directives.
615  If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."  The IGNORE argument is not used."
616    (interactive "P")    (interactive "P")
617    (if (not mh-gnus-pgp-support-flag)    (if (not mh-gnus-pgp-support-flag)
618        (error "Sorry.  Your version of gnus does not support PGP/GPG")        (error "Sorry.  Your version of gnus does not support PGP/GPG")
619      (mml-secure-message-encrypt-pgpmime dontsign)))      (mml-unsecure-message)))
620    
621    ;;;###mh-autoload
622    (defun mh-mml-secure-message-sign (method)
623      "Add security directive to sign the entire message using METHOD."
624      (interactive (list (mh-mml-query-cryptographic-method)))
625      (mh-secure-message method "sign" mh-identity-pgg-default-user-id))
626    
627    ;;;###mh-autoload
628    (defun mh-mml-secure-message-encrypt (method)
629      "Add security directive to encrypt the entire message using METHOD."
630      (interactive (list (mh-mml-query-cryptographic-method)))
631      (mh-secure-message method "encrypt" mh-identity-pgg-default-user-id))
632    
633    ;;;###mh-autoload
634    (defun mh-mml-secure-message-signencrypt (method)
635      "Add security directive to encrypt and sign the entire message using METHOD."
636      (interactive (list (mh-mml-query-cryptographic-method)))
637      (mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id))
638    
639  ;;;###mh-autoload  ;;;###mh-autoload
640  (defun mh-mml-directive-present-p ()  (defun mh-mml-directive-present-p ()
# Line 667  actual storing." Line 787  actual storing."
787          (folder (if (eq major-mode 'mh-show-mode)          (folder (if (eq major-mode 'mh-show-mode)
788                      mh-show-folder-buffer                      mh-show-folder-buffer
789                    mh-current-folder))                    mh-current-folder))
790          (command (if mh-nmh-flag "mhstore" "mhn"))          (command (if (mh-variant-p 'nmh) "mhstore" "mhn"))
791          (directory          (directory
792           (cond           (cond
793            ((and (or arg            ((and (or arg
794                      (equal nil mh-mime-save-parts-default-directory)                      (equal nil mh-mime-save-parts-default-directory)
795                      (equal t mh-mime-save-parts-default-directory))                      (equal t mh-mime-save-parts-default-directory))
796                  (not mh-mime-save-parts-directory))                  (not mh-mime-save-parts-directory))
797             (read-file-name "Store in what directory? " nil nil t nil))             (read-file-name "Store in directory: " nil nil t nil))
798            ((and (or arg            ((and (or arg
799                      (equal t mh-mime-save-parts-default-directory))                      (equal t mh-mime-save-parts-default-directory))
800                  mh-mime-save-parts-directory)                  mh-mime-save-parts-directory)
801             (read-file-name (format             (read-file-name (format
802                              "Store in what directory? [%s] "                              "Store in directory: [%s] "
803                              mh-mime-save-parts-directory)                              mh-mime-save-parts-directory)
804                             "" mh-mime-save-parts-directory t ""))                             "" mh-mime-save-parts-directory t ""))
805            ((stringp mh-mime-save-parts-default-directory)            ((stringp mh-mime-save-parts-default-directory)
# Line 689  actual storing." Line 809  actual storing."
809      (if (and (equal directory "") mh-mime-save-parts-directory)      (if (and (equal directory "") mh-mime-save-parts-directory)
810          (setq directory mh-mime-save-parts-directory))          (setq directory mh-mime-save-parts-directory))
811      (if (not (file-directory-p directory))      (if (not (file-directory-p directory))
812          (message "No directory specified.")          (message "No directory specified")
813        (if (equal nil mh-mime-save-parts-default-directory)        (if (equal nil mh-mime-save-parts-default-directory)
814            (setq mh-mime-save-parts-directory directory))            (setq mh-mime-save-parts-directory directory))
815        (save-excursion        (save-excursion
# Line 732  If message has been encoded for transfer Line 852  If message has been encoded for transfer
852                          (car ct))))))                          (car ct))))))
853    
854  ;;;###mh-autoload  ;;;###mh-autoload
855    (defun mh-toggle-mh-decode-mime-flag ()
856      "Toggle whether MH-E should decode MIME or not."
857      (interactive)
858      (setq mh-decode-mime-flag (not mh-decode-mime-flag))
859      (mh-show nil t)
860      (message (format "(setq mh-decode-mime-flag %s)" mh-decode-mime-flag)))
861    
862    ;;;###mh-autoload
863  (defun mh-decode-message-header ()  (defun mh-decode-message-header ()
864    "Decode RFC2047 encoded message header fields."    "Decode RFC2047 encoded message header fields."
865    (when mh-decode-mime-flag    (when mh-decode-mime-flag
# Line 766  displayed." Line 894  displayed."
894                                        (mh-mime-handles (mh-buffer-data))))                                        (mh-mime-handles (mh-buffer-data))))
895                (unless handles (mh-decode-message-body)))                (unless handles (mh-decode-message-body)))
896    
897              (when (and handles              (cond ((and handles
898                         (or (not (stringp (car handles))) (cdr handles)))                          (or (not (stringp (car handles))) (cdr handles)))
899                ;; Goto start of message body                     ;; Goto start of message body
900                (goto-char (point-min))                     (goto-char (point-min))
901                (or (search-forward "\n\n" nil t) (goto-char (point-max)))                     (or (search-forward "\n\n" nil t) (goto-char (point-max)))
902    
903                ;; Delete the body                     ;; Delete the body
904                (delete-region (point) (point-max))                     (delete-region (point) (point-max))
905    
906                ;; Display the MIME handles                     ;; Display the MIME handles
907                (mh-mime-display-part handles)))                     (mh-mime-display-part handles))
908                      (t (mh-signature-highlight))))
909          (error          (error
910           (message "Please report this error. The error message is:\n %s"           (message "Please report this error. The error message is:\n %s"
911                    (error-message-string err))                    (error-message-string err))
# Line 874  This is only useful if a Content-Disposi Line 1003  This is only useful if a Content-Disposi
1003             (save-restriction             (save-restriction
1004               (widen)               (widen)
1005               (goto-char (point-min))               (goto-char (point-min))
1006               (not (re-search-forward "^-- $" nil t)))))))               (not (mh-signature-separator-p)))))))
1007    
1008  (defun mh-mime-display-single (handle)  (defun mh-mime-display-single (handle)
1009    "Display a leaf node, HANDLE in the MIME tree."    "Display a leaf node, HANDLE in the MIME tree."
# Line 904  This is only useful if a Content-Disposi Line 1033  This is only useful if a Content-Disposi
1033               (insert "\n")               (insert "\n")
1034               (mh-insert-mime-button handle (mh-mime-part-index handle) nil))               (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
1035              ((and displayp (not mh-display-buttons-for-inline-parts-flag))              ((and displayp (not mh-display-buttons-for-inline-parts-flag))
1036               (or (mm-display-part handle) (mm-display-part handle)))               (or (mm-display-part handle) (mm-display-part handle))
1037                 (mh-signature-highlight handle))
1038              ((and displayp mh-display-buttons-for-inline-parts-flag)              ((and displayp mh-display-buttons-for-inline-parts-flag)
1039               (insert "\n")               (insert "\n")
1040               (mh-insert-mime-button handle (mh-mime-part-index handle) nil)               (mh-insert-mime-button handle (mh-mime-part-index handle) nil)
# Line 912  This is only useful if a Content-Disposi Line 1042  This is only useful if a Content-Disposi
1042               (mh-mm-display-part handle)))               (mh-mm-display-part handle)))
1043        (goto-char (point-max)))))        (goto-char (point-max)))))
1044    
1045    (defun mh-signature-highlight (&optional handle)
1046      "Highlight message signature in HANDLE.
1047    The optional argument, HANDLE is a MIME handle if the function is being used
1048    to highlight the signature in a MIME part."
1049      (let ((regexp
1050             (cond ((not handle) "^-- $")
1051                   ((not (and (equal (mm-handle-media-supertype handle) "text")
1052                              (equal (mm-handle-media-subtype handle) "html")))
1053                    "^-- $")
1054                   ((eq (mh-mm-text-html-renderer) 'lynx) "^   --$")
1055                   (t "^--$"))))
1056        (save-excursion
1057          (goto-char (point-max))
1058          (when (re-search-backward regexp nil t)
1059            (mh-do-in-gnu-emacs
1060              (let ((ov (make-overlay (point) (point-max))))
1061                (overlay-put ov 'face 'mh-show-signature-face)
1062                (overlay-put ov 'evaporate t)))
1063            (mh-do-in-xemacs
1064              (set-extent-property (make-extent (point) (point-max))
1065                                   'face 'mh-show-signature-face))))))
1066    
1067  (mh-do-in-xemacs  (mh-do-in-xemacs
1068   (defvar dots)   (defvar dots)
1069   (defvar type))   (defvar type))
# Line 954  like \"K v\" which operate on individual Line 1106  like \"K v\" which operate on individual
1106       :action 'mh-widget-press-button       :action 'mh-widget-press-button
1107       :button-keymap mh-mime-button-map       :button-keymap mh-mime-button-map
1108       :help-echo       :help-echo
1109       "Mouse-2 click or press RET (in show buffer) to toggle display")))       "Mouse-2 click or press RET (in show buffer) to toggle display")
1110        (dolist (ov (mh-funcall-if-exists overlays-in begin end))
1111          (mh-funcall-if-exists overlay-put ov 'evaporate t))))
1112    
1113  ;; There is a bug in Gnus inline image display due to which an extra line  ;; There is a bug in Gnus inline image display due to which an extra line
1114  ;; gets inserted every time it is viewed. To work around that problem we are  ;; gets inserted every time it is viewed. To work around that problem we are
# Line 1009  like \"K v\" which operate on individual Line 1163  like \"K v\" which operate on individual
1163                    (when (eq mh-highlight-citation-p 'gnus)                    (when (eq mh-highlight-citation-p 'gnus)
1164                      (mh-gnus-article-highlight-citation))                      (mh-gnus-article-highlight-citation))
1165                    (mh-display-smileys)                    (mh-display-smileys)
1166                    (mh-display-emphasis))                    (mh-display-emphasis)
1167                      (mh-signature-highlight handle))
1168                  (setq region (cons (progn (goto-char (point-min))                  (setq region (cons (progn (goto-char (point-min))
1169                                            (point-marker))                                            (point-marker))
1170                                     (progn (goto-char (point-max))                                     (progn (goto-char (point-max))
# Line 1098  button." Line 1253  button."
1253      (goto-char point)      (goto-char point)
1254      (set-buffer-modified-p nil)))      (set-buffer-modified-p nil)))
1255    
1256    ;;;###mh-autoload
1257    (defun mh-display-with-external-viewer (part-index)
1258      "View MIME PART-INDEX externally."
1259      (interactive "P")
1260      (when (consp part-index) (setq part-index (car part-index)))
1261      (mh-folder-mime-action
1262       part-index
1263       #'(lambda ()
1264           (let* ((part (get-text-property (point) 'mh-data))
1265                  (type (mm-handle-media-type part))
1266                  (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
1267                                   (mailcap-mime-info type 'all)))
1268                  (def (caar methods))
1269                  (prompt (format "Viewer: %s" (if def (format "[%s] " def) "")))
1270                  (method (completing-read prompt methods nil nil nil nil def))
1271                  (folder mh-show-folder-buffer)
1272                  (buffer-read-only nil))
1273             (when (string-match "^[^% \t]+$" method)
1274               (setq method (concat method " %s")))
1275             (flet ((mm-handle-set-external-undisplayer (handle function)
1276                      (mh-handle-set-external-undisplayer folder handle function)))
1277               (unwind-protect (mm-display-external part method)
1278                 (set-buffer-modified-p nil)))))
1279       nil))
1280    
1281  (defun mh-widget-press-button (widget el)  (defun mh-widget-press-button (widget el)
1282    "Callback for widget, WIDGET.    "Callback for widget, WIDGET.
1283  Parameter EL is unused."  Parameter EL is unused."
# Line 1106  Parameter EL is unused." Line 1286  Parameter EL is unused."
1286    
1287  (defun mh-mime-display-security (handle)  (defun mh-mime-display-security (handle)
1288    "Display PGP encrypted/signed message, HANDLE."    "Display PGP encrypted/signed message, HANDLE."
   (insert "\n")  
1289    (save-restriction    (save-restriction
1290      (narrow-to-region (point) (point))      (narrow-to-region (point) (point))
1291        (insert "\n")
1292      (mh-insert-mime-security-button handle)      (mh-insert-mime-security-button handle)
1293      (mh-mime-display-mixed (cdr handle))      (mh-mime-display-mixed (cdr handle))
1294      (insert "\n")      (insert "\n")
# Line 1116  Parameter EL is unused." Line 1296  Parameter EL is unused."
1296             mh-mime-security-button-end-line-format))             mh-mime-security-button-end-line-format))
1297        (mh-insert-mime-security-button handle))        (mh-insert-mime-security-button handle))
1298      (mm-set-handle-multipart-parameter      (mm-set-handle-multipart-parameter
1299       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))))))  
1300    
1301  ;;; I rewrote the security part because Gnus doesn't seem to ever minimize  ;;; I rewrote the security part because Gnus doesn't seem to ever minimize
1302  ;;; the button. That is once the mime-security button is pressed there seems  ;;; the button. That is once the mime-security button is pressed there seems
# Line 1149  Parameter EL is unused." Line 1327  Parameter EL is unused."
1327    
1328  (defun mh-mime-security-press-button (handle)  (defun mh-mime-security-press-button (handle)
1329    "Callback from security button for part HANDLE."    "Callback from security button for part HANDLE."
1330    (when (mm-handle-multipart-ctl-parameter handle 'gnus-info)    (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
1331      (mh-mime-security-show-details handle)))        (mh-mime-security-show-details handle)
1332        (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region))
1333              point)
1334          (setq point (point))
1335          (goto-char (car region))
1336          (delete-region (car region) (cdr region))
1337          (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
1338            (let* ((mm-verify-option 'known)
1339                   (mm-decrypt-option 'known)
1340                   (new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
1341              (unless (eq new (cdr handle))
1342                (mm-destroy-parts (cdr handle))
1343                (setcdr handle new))))
1344          (mh-mime-display-security handle)
1345          (goto-char point))))
1346    
1347  ;; These variables should already be initialized in mm-decode.el if we have a  ;; These variables should already be initialized in mm-decode.el if we have a
1348  ;; recent enough Gnus. The defvars are here to avoid compiler warnings.  ;; recent enough Gnus. The defvars are here to avoid compiler warnings.
# Line 1191  Parameter EL is unused." Line 1383  Parameter EL is unused."
1383                             :action 'mh-widget-press-button                             :action 'mh-widget-press-button
1384                             :button-keymap mh-mime-security-button-map                             :button-keymap mh-mime-security-button-map
1385                             :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")                             :help-echo "Mouse-2 click or press RET (in show buffer) to see security details.")
1386        (dolist (ov (mh-funcall-if-exists overlays-in begin end))
1387          (mh-funcall-if-exists overlay-put ov 'evaporate t))
1388      (when (equal info "Failed")      (when (equal info "Failed")
1389        (let* ((type (if (equal (car handle) "multipart/signed")        (let* ((type (if (equal (car handle) "multipart/signed")
1390                         "verification" "decryption"))                         "verification" "decryption"))
# Line 1204  The function decodes the message and dis Line 1398  The function decodes the message and dis
1398  message multiple times."  message multiple times."
1399    (let ((b (point))    (let ((b (point))
1400          (clean-message-header mh-clean-message-header-flag)          (clean-message-header mh-clean-message-header-flag)
1401          (invisible-headers mh-invisible-headers)          (invisible-headers mh-invisible-header-fields-compiled)
1402          (visible-headers mh-visible-headers))          (visible-headers nil))
1403      (save-excursion      (save-excursion
1404        (save-restriction        (save-restriction
1405          (narrow-to-region b b)          (narrow-to-region b b)

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.5.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26