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) |
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") |
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) |
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." |
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. |
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." |
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. |
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 |
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 |
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")) |
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) |
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 |
|
|
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 |
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. |
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 |
|
|
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) |
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. |
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 () |
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) |
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 |
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)) |
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." |
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) |
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)) |
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 |
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)) |
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." |
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") |
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 |
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. |
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")) |
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) |