/[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.2.4.3 by miles, Sat Jul 17 02:51:49 2004 UTC revision 1.2.4.4 by miles, Sat Sep 4 09:22:56 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  (defun mh-secure-message (method mode &optional identity)
587  (defun mh-mml-secure-message-sign-pgpmime ()    "Add directive to Encrypt/Sign an entire message.
588    "Add directive to encrypt/sign the entire message."  METHOD should be one of: \"pgpmime\", \"pgp\", \"smime\".
589    (interactive)  MODE should be one of: \"sign\", \"encrypt\", \"signencrypt\", \"none\".
590    IDENTITY is optionally the default-user-id to use."
591    (if (not mh-gnus-pgp-support-flag)    (if (not mh-gnus-pgp-support-flag)
592        (error "Sorry.  Your version of gnus does not support PGP/GPG")        (error "Sorry.  Your version of gnus does not support PGP/GPG")
593      (mml-secure-message-sign-pgpmime)))      ;; Check the arguments
594        (let ((valid-methods (list "pgpmime" "pgp" "smime"))
595              (valid-modes (list "sign" "encrypt" "signencrypt" "none")))
596          (if (not (member method valid-methods))
597              (error (format "Sorry. METHOD \"%s\" is invalid." method)))
598          (if (not (member mode valid-modes))
599              (error (format "Sorry. MODE \"%s\" is invalid" mode)))
600          (mml-unsecure-message)
601          (if (not (string= mode "none"))
602            (save-excursion
603              (goto-char (point-min))
604              (mh-goto-header-end 1)
605              (if mh-identity-pgg-default-user-id
606                  (mml-insert-tag 'secure 'method method 'mode mode
607                                  'sender mh-identity-pgg-default-user-id)
608                (mml-insert-tag 'secure 'method method 'mode mode)))))))
609    
610  ;;;###mh-autoload  ;;;###mh-autoload
611  (defun mh-mml-secure-message-encrypt-pgpmime (&optional dontsign)  (defun mh-mml-unsecure-message (&optional ignore)
612    "Add directive to encrypt and sign the entire message.    "Remove any secure message directives.
613  If called with a prefix argument DONTSIGN, only encrypt (do NOT sign)."  The IGNORE argument is not used."
614    (interactive "P")    (interactive "P")
615    (if (not mh-gnus-pgp-support-flag)    (if (not mh-gnus-pgp-support-flag)
616        (error "Sorry.  Your version of gnus does not support PGP/GPG")        (error "Sorry.  Your version of gnus does not support PGP/GPG")
617      (mml-secure-message-encrypt-pgpmime dontsign)))      (mml-unsecure-message)))
618    
619    ;;;###mh-autoload
620    (defun mh-mml-secure-message-sign (method)
621      "Add security directive to sign the entire message using METHOD."
622      (interactive (list (mh-mml-query-cryptographic-method)))
623      (mh-secure-message method "sign" mh-identity-pgg-default-user-id))
624    
625    ;;;###mh-autoload
626    (defun mh-mml-secure-message-encrypt (method)
627      "Add security directive to encrypt the entire message using METHOD."
628      (interactive (list (mh-mml-query-cryptographic-method)))
629      (mh-secure-message method "encrypt" mh-identity-pgg-default-user-id))
630    
631    ;;;###mh-autoload
632    (defun mh-mml-secure-message-signencrypt (method)
633      "Add security directive to encrypt and sign the entire message using METHOD."
634      (interactive (list (mh-mml-query-cryptographic-method)))
635      (mh-secure-message method "signencrypt" mh-identity-pgg-default-user-id))
636    
637  ;;;###mh-autoload  ;;;###mh-autoload
638  (defun mh-mml-directive-present-p ()  (defun mh-mml-directive-present-p ()
# Line 667  actual storing." Line 785  actual storing."
785          (folder (if (eq major-mode 'mh-show-mode)          (folder (if (eq major-mode 'mh-show-mode)
786                      mh-show-folder-buffer                      mh-show-folder-buffer
787                    mh-current-folder))                    mh-current-folder))
788          (command (if mh-nmh-flag "mhstore" "mhn"))          (command (if (mh-variant-p 'nmh) "mhstore" "mhn"))
789          (directory          (directory
790           (cond           (cond
791            ((and (or arg            ((and (or arg
792                      (equal nil mh-mime-save-parts-default-directory)                      (equal nil mh-mime-save-parts-default-directory)
793                      (equal t mh-mime-save-parts-default-directory))                      (equal t mh-mime-save-parts-default-directory))
794                  (not mh-mime-save-parts-directory))                  (not mh-mime-save-parts-directory))
795             (read-file-name "Store in what directory? " nil nil t nil))             (read-file-name "Store in directory: " nil nil t nil))
796            ((and (or arg            ((and (or arg
797                      (equal t mh-mime-save-parts-default-directory))                      (equal t mh-mime-save-parts-default-directory))
798                  mh-mime-save-parts-directory)                  mh-mime-save-parts-directory)
799             (read-file-name (format             (read-file-name (format
800                              "Store in what directory? [%s] "                              "Store in directory: [%s] "
801                              mh-mime-save-parts-directory)                              mh-mime-save-parts-directory)
802                             "" mh-mime-save-parts-directory t ""))                             "" mh-mime-save-parts-directory t ""))
803            ((stringp mh-mime-save-parts-default-directory)            ((stringp mh-mime-save-parts-default-directory)
# Line 689  actual storing." Line 807  actual storing."
807      (if (and (equal directory "") mh-mime-save-parts-directory)      (if (and (equal directory "") mh-mime-save-parts-directory)
808          (setq directory mh-mime-save-parts-directory))          (setq directory mh-mime-save-parts-directory))
809      (if (not (file-directory-p directory))      (if (not (file-directory-p directory))
810          (message "No directory specified.")          (message "No directory specified")
811        (if (equal nil mh-mime-save-parts-default-directory)        (if (equal nil mh-mime-save-parts-default-directory)
812            (setq mh-mime-save-parts-directory directory))            (setq mh-mime-save-parts-directory directory))
813        (save-excursion        (save-excursion
# Line 766  displayed." Line 884  displayed."
884                                        (mh-mime-handles (mh-buffer-data))))                                        (mh-mime-handles (mh-buffer-data))))
885                (unless handles (mh-decode-message-body)))                (unless handles (mh-decode-message-body)))
886    
887              (when (and handles              (cond ((and handles
888                         (or (not (stringp (car handles))) (cdr handles)))                          (or (not (stringp (car handles))) (cdr handles)))
889                ;; Goto start of message body                     ;; Goto start of message body
890                (goto-char (point-min))                     (goto-char (point-min))
891                (or (search-forward "\n\n" nil t) (goto-char (point-max)))                     (or (search-forward "\n\n" nil t) (goto-char (point-max)))
892    
893                ;; Delete the body                     ;; Delete the body
894                (delete-region (point) (point-max))                     (delete-region (point) (point-max))
895    
896                ;; Display the MIME handles                     ;; Display the MIME handles
897                (mh-mime-display-part handles)))                     (mh-mime-display-part handles))
898                      (t (mh-signature-highlight))))
899          (error          (error
900           (message "Please report this error. The error message is:\n %s"           (message "Please report this error. The error message is:\n %s"
901                    (error-message-string err))                    (error-message-string err))
# Line 874  This is only useful if a Content-Disposi Line 993  This is only useful if a Content-Disposi
993             (save-restriction             (save-restriction
994               (widen)               (widen)
995               (goto-char (point-min))               (goto-char (point-min))
996               (not (re-search-forward "^-- $" nil t)))))))               (not (mh-signature-separator-p)))))))
997    
998  (defun mh-mime-display-single (handle)  (defun mh-mime-display-single (handle)
999    "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 1023  This is only useful if a Content-Disposi
1023               (insert "\n")               (insert "\n")
1024               (mh-insert-mime-button handle (mh-mime-part-index handle) nil))               (mh-insert-mime-button handle (mh-mime-part-index handle) nil))
1025              ((and displayp (not mh-display-buttons-for-inline-parts-flag))              ((and displayp (not mh-display-buttons-for-inline-parts-flag))
1026               (or (mm-display-part handle) (mm-display-part handle)))               (or (mm-display-part handle) (mm-display-part handle))
1027                 (mh-signature-highlight handle))
1028              ((and displayp mh-display-buttons-for-inline-parts-flag)              ((and displayp mh-display-buttons-for-inline-parts-flag)
1029               (insert "\n")               (insert "\n")
1030               (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 1032  This is only useful if a Content-Disposi
1032               (mh-mm-display-part handle)))               (mh-mm-display-part handle)))
1033        (goto-char (point-max)))))        (goto-char (point-max)))))
1034    
1035    (defun mh-signature-highlight (&optional handle)
1036      "Highlight message signature in HANDLE.
1037    The optional argument, HANDLE is a MIME handle if the function is being used
1038    to highlight the signature in a MIME part."
1039      (let ((regexp
1040             (cond ((not handle) "^-- $")
1041                   ((not (and (equal (mm-handle-media-supertype handle) "text")
1042                              (equal (mm-handle-media-subtype handle) "html")))
1043                    "^-- $")
1044                   ((eq (mh-mm-text-html-renderer) 'lynx) "^   --$")
1045                   (t "^--$"))))
1046        (save-excursion
1047          (goto-char (point-max))
1048          (when (re-search-backward regexp nil t)
1049            (mh-do-in-gnu-emacs
1050              (let ((ov (make-overlay (point) (point-max))))
1051                (overlay-put ov 'face 'mh-show-signature-face)
1052                (overlay-put ov 'evaporate t)))
1053            (mh-do-in-xemacs
1054              (set-extent-property (make-extent (point) (point-max))
1055                                   'face 'mh-show-signature-face))))))
1056    
1057  (mh-do-in-xemacs  (mh-do-in-xemacs
1058   (defvar dots)   (defvar dots)
1059   (defvar type))   (defvar type))
# Line 954  like \"K v\" which operate on individual Line 1096  like \"K v\" which operate on individual
1096       :action 'mh-widget-press-button       :action 'mh-widget-press-button
1097       :button-keymap mh-mime-button-map       :button-keymap mh-mime-button-map
1098       :help-echo       :help-echo
1099       "Mouse-2 click or press RET (in show buffer) to toggle display")))       "Mouse-2 click or press RET (in show buffer) to toggle display")
1100        (dolist (ov (mh-funcall-if-exists overlays-in begin end))
1101          (mh-funcall-if-exists overlay-put ov 'evaporate t))))
1102    
1103  ;; 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
1104  ;; 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 1153  like \"K v\" which operate on individual
1153                    (when (eq mh-highlight-citation-p 'gnus)                    (when (eq mh-highlight-citation-p 'gnus)
1154                      (mh-gnus-article-highlight-citation))                      (mh-gnus-article-highlight-citation))
1155                    (mh-display-smileys)                    (mh-display-smileys)
1156                    (mh-display-emphasis))                    (mh-display-emphasis)
1157                      (mh-signature-highlight handle))
1158                  (setq region (cons (progn (goto-char (point-min))                  (setq region (cons (progn (goto-char (point-min))
1159                                            (point-marker))                                            (point-marker))
1160                                     (progn (goto-char (point-max))                                     (progn (goto-char (point-max))
# Line 1098  button." Line 1243  button."
1243      (goto-char point)      (goto-char point)
1244      (set-buffer-modified-p nil)))      (set-buffer-modified-p nil)))
1245    
1246    ;;;###mh-autoload
1247    (defun mh-display-with-external-viewer (part-index)
1248      "View MIME PART-INDEX externally."
1249      (interactive "P")
1250      (when (consp part-index) (setq part-index (car part-index)))
1251      (mh-folder-mime-action
1252       part-index
1253       #'(lambda ()
1254           (let* ((part (get-text-property (point) 'mh-data))
1255                  (type (mm-handle-media-type part))
1256                  (methods (mapcar (lambda (x) (list (cdr (assoc 'viewer x))))
1257                                   (mailcap-mime-info type 'all)))
1258                  (def (caar methods))
1259                  (prompt (format "Viewer: %s" (if def (format "[%s] " def) "")))
1260                  (method (completing-read prompt methods nil nil nil nil def))
1261                  (folder mh-show-folder-buffer)
1262                  (buffer-read-only nil))
1263             (when (string-match "^[^% \t]+$" method)
1264               (setq method (concat method " %s")))
1265             (flet ((mm-handle-set-external-undisplayer (handle function)
1266                      (mh-handle-set-external-undisplayer folder handle function)))
1267               (unwind-protect (mm-display-external part method)
1268                 (set-buffer-modified-p nil)))))
1269       nil))
1270    
1271  (defun mh-widget-press-button (widget el)  (defun mh-widget-press-button (widget el)
1272    "Callback for widget, WIDGET.    "Callback for widget, WIDGET.
1273  Parameter EL is unused."  Parameter EL is unused."
# Line 1106  Parameter EL is unused." Line 1276  Parameter EL is unused."
1276    
1277  (defun mh-mime-display-security (handle)  (defun mh-mime-display-security (handle)
1278    "Display PGP encrypted/signed message, HANDLE."    "Display PGP encrypted/signed message, HANDLE."
   (insert "\n")  
1279    (save-restriction    (save-restriction
1280      (narrow-to-region (point) (point))      (narrow-to-region (point) (point))
1281        (insert "\n")
1282      (mh-insert-mime-security-button handle)      (mh-insert-mime-security-button handle)
1283      (mh-mime-display-mixed (cdr handle))      (mh-mime-display-mixed (cdr handle))
1284      (insert "\n")      (insert "\n")
# Line 1116  Parameter EL is unused." Line 1286  Parameter EL is unused."
1286             mh-mime-security-button-end-line-format))             mh-mime-security-button-end-line-format))
1287        (mh-insert-mime-security-button handle))        (mh-insert-mime-security-button handle))
1288      (mm-set-handle-multipart-parameter      (mm-set-handle-multipart-parameter
1289       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))))))  
1290    
1291  ;;; 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
1292  ;;; 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 1317  Parameter EL is unused."
1317    
1318  (defun mh-mime-security-press-button (handle)  (defun mh-mime-security-press-button (handle)
1319    "Callback from security button for part HANDLE."    "Callback from security button for part HANDLE."
1320    (when (mm-handle-multipart-ctl-parameter handle 'gnus-info)    (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
1321      (mh-mime-security-show-details handle)))        (mh-mime-security-show-details handle)
1322        (let ((region (mm-handle-multipart-ctl-parameter handle 'mh-region))
1323              point)
1324          (setq point (point))
1325          (goto-char (car region))
1326          (delete-region (car region) (cdr region))
1327          (with-current-buffer (mm-handle-multipart-ctl-parameter handle 'buffer)
1328            (let* ((mm-verify-option 'known)
1329                   (mm-decrypt-option 'known)
1330                   (new (mm-possibly-verify-or-decrypt (cdr handle) handle)))
1331              (unless (eq new (cdr handle))
1332                (mm-destroy-parts (cdr handle))
1333                (setcdr handle new))))
1334          (mh-mime-display-security handle)
1335          (goto-char point))))
1336    
1337  ;; 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
1338  ;; 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 1373  Parameter EL is unused."
1373                             :action 'mh-widget-press-button                             :action 'mh-widget-press-button
1374                             :button-keymap mh-mime-security-button-map                             :button-keymap mh-mime-security-button-map
1375                             :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.")
1376        (dolist (ov (mh-funcall-if-exists overlays-in begin end))
1377          (mh-funcall-if-exists overlay-put ov 'evaporate t))
1378      (when (equal info "Failed")      (when (equal info "Failed")
1379        (let* ((type (if (equal (car handle) "multipart/signed")        (let* ((type (if (equal (car handle) "multipart/signed")
1380                         "verification" "decryption"))                         "verification" "decryption"))
# Line 1204  The function decodes the message and dis Line 1388  The function decodes the message and dis
1388  message multiple times."  message multiple times."
1389    (let ((b (point))    (let ((b (point))
1390          (clean-message-header mh-clean-message-header-flag)          (clean-message-header mh-clean-message-header-flag)
1391          (invisible-headers mh-invisible-headers)          (invisible-headers mh-invisible-header-fields-compiled)
1392          (visible-headers mh-visible-headers))          (visible-headers nil))
1393      (save-excursion      (save-excursion
1394        (save-restriction        (save-restriction
1395          (narrow-to-region b b)          (narrow-to-region b b)

Legend:
Removed from v.1.2.4.3  
changed lines
  Added in v.1.2.4.4

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