diff options
| -rw-r--r-- | lisp/mail/pmail.el | 2957 |
1 files changed, 1864 insertions, 1093 deletions
diff --git a/lisp/mail/pmail.el b/lisp/mail/pmail.el index 2c6de2e4b24..e82a02e6bca 100644 --- a/lisp/mail/pmail.el +++ b/lisp/mail/pmail.el | |||
| @@ -2,7 +2,7 @@ | |||
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998, | 3 | ;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998, |
| 4 | ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 | 4 | ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 |
| 5 | ; Free Software Foundation, Inc. | 5 | ;; Free Software Foundation, Inc. |
| 6 | 6 | ||
| 7 | ;; Maintainer: FSF | 7 | ;; Maintainer: FSF |
| 8 | ;; Keywords: mail | 8 | ;; Keywords: mail |
| @@ -38,26 +38,72 @@ | |||
| 38 | ;; variable, and a bury pmail buffer (wipe) command. | 38 | ;; variable, and a bury pmail buffer (wipe) command. |
| 39 | ;; | 39 | ;; |
| 40 | 40 | ||
| 41 | (eval-when-compile | 41 | (require 'mail-utils) |
| 42 | (require 'font-lock) | 42 | (eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority |
| 43 | (require 'mailabbrev) | ||
| 44 | (require 'mule-util)) ; for detect-coding-with-priority | ||
| 45 | 43 | ||
| 46 | (require 'pmaildesc) | 44 | (defconst pmail-attribute-header "X-BABYL-V6-ATTRIBUTES" |
| 47 | (require 'pmailhdr) | 45 | "The header that stores the Pmail attribute data.") |
| 48 | (require 'pmailkwd) | 46 | |
| 49 | (require 'mail-parse) | 47 | (defconst pmail-keyword-header "X-BABYL-V6-KEYWORDS" |
| 48 | "The header that stores the Pmail keyword data.") | ||
| 49 | |||
| 50 | ;;; Attribute indexes | ||
| 51 | |||
| 52 | (defconst pmail-answered-attr-index 0 | ||
| 53 | "The index for the `answered' attribute.") | ||
| 54 | |||
| 55 | (defconst pmail-deleted-attr-index 1 | ||
| 56 | "The index for the `deleted' attribute.") | ||
| 57 | |||
| 58 | (defconst pmail-edited-attr-index 2 | ||
| 59 | "The index for the `edited' attribute.") | ||
| 60 | |||
| 61 | (defconst pmail-filed-attr-index 3 | ||
| 62 | "The index for the `filed' attribute.") | ||
| 63 | |||
| 64 | (defconst pmail-resent-attr-index 4 | ||
| 65 | "The index for the `resent' attribute.") | ||
| 66 | |||
| 67 | (defconst pmail-stored-attr-index 5 | ||
| 68 | "The index for the `stored' attribute.") | ||
| 69 | |||
| 70 | (defconst pmail-unseen-attr-index 6 | ||
| 71 | "The index for the `unseen' attribute.") | ||
| 72 | |||
| 73 | (defconst pmail-attr-array | ||
| 74 | '[(?A "answered") | ||
| 75 | (?D "deleted") | ||
| 76 | (?E "edited") | ||
| 77 | (?F "filed") | ||
| 78 | (?R "replied") | ||
| 79 | (?S "stored") | ||
| 80 | (?U "unseen")] | ||
| 81 | "An array that provides a mapping between an attribute index, | ||
| 82 | it's character representation and it's display representation.") | ||
| 83 | |||
| 84 | (defconst pmail-attribute-field-name "x-babyl-v6-attributes" | ||
| 85 | "The message header field added by Rmail to maintain status.") | ||
| 50 | 86 | ||
| 51 | (defvar deleted-head) | 87 | (defvar deleted-head) |
| 52 | (defvar font-lock-fontified) | 88 | (defvar font-lock-fontified) |
| 53 | (defvar mail-abbrev-syntax-table) | 89 | (defvar mail-abbrev-syntax-table) |
| 54 | (defvar mail-abbrevs) | 90 | (defvar mail-abbrevs) |
| 55 | (defvar messages-head) | 91 | (defvar messages-head) |
| 92 | (defvar pmail-use-spam-filter) | ||
| 56 | (defvar rsf-beep) | 93 | (defvar rsf-beep) |
| 57 | (defvar rsf-sleep-after-message) | 94 | (defvar rsf-sleep-after-message) |
| 58 | (defvar total-messages) | 95 | (defvar total-messages) |
| 59 | (defvar tool-bar-map) | 96 | (defvar tool-bar-map) |
| 60 | 97 | ||
| 98 | (defvar pmail-buffers-swapped-p nil | ||
| 99 | "A flag that is non-nil when the message view buffer and the | ||
| 100 | message collection buffer are swapped, i.e. the Pmail buffer | ||
| 101 | contains a single decoded message.") | ||
| 102 | |||
| 103 | (defvar pmail-header-style 'normal | ||
| 104 | "The current header display style choice, one of | ||
| 105 | 'normal (selected headers) or 'full (all headers).") | ||
| 106 | |||
| 61 | ; These variables now declared in paths.el. | 107 | ; These variables now declared in paths.el. |
| 62 | ;(defvar pmail-spool-directory "/usr/spool/mail/" | 108 | ;(defvar pmail-spool-directory "/usr/spool/mail/" |
| 63 | ; "This is the name of the directory used by the system mailer for\n\ | 109 | ; "This is the name of the directory used by the system mailer for\n\ |
| @@ -185,11 +231,6 @@ please report it with \\[report-emacs-bug].") | |||
| 185 | 231 | ||
| 186 | (defvar pmail-encoded-remote-password nil) | 232 | (defvar pmail-encoded-remote-password nil) |
| 187 | 233 | ||
| 188 | (defvar pmail-expunge-counter 0 | ||
| 189 | "A counter used to keep track of the number of expunged | ||
| 190 | messages with a lower message number than the current message | ||
| 191 | index.") | ||
| 192 | |||
| 193 | (defcustom pmail-preserve-inbox nil | 234 | (defcustom pmail-preserve-inbox nil |
| 194 | "*Non-nil means leave incoming mail in the user's inbox--don't delete it." | 235 | "*Non-nil means leave incoming mail in the user's inbox--don't delete it." |
| 195 | :type 'boolean | 236 | :type 'boolean |
| @@ -202,12 +243,8 @@ index.") | |||
| 202 | 243 | ||
| 203 | (declare-function mail-position-on-field "sendmail" (field &optional soft)) | 244 | (declare-function mail-position-on-field "sendmail" (field &optional soft)) |
| 204 | (declare-function mail-text-start "sendmail" ()) | 245 | (declare-function mail-text-start "sendmail" ()) |
| 246 | (declare-function pmail-dont-reply-to "mail-utils" (destinations)) | ||
| 205 | (declare-function pmail-update-summary "pmailsum" (&rest ignore)) | 247 | (declare-function pmail-update-summary "pmailsum" (&rest ignore)) |
| 206 | (declare-function unrmail "unrmail" (file to-file)) | ||
| 207 | (declare-function rmail-dont-reply-to "mail-utils" (destinations)) | ||
| 208 | (declare-function pmail-summary-goto-msg "pmailsum" (&optional n nowarn skip-pmail)) | ||
| 209 | (declare-function pmail-summary-pmail-update "pmailsum" ()) | ||
| 210 | (declare-function pmail-summary-update "pmailsum" (n)) | ||
| 211 | 248 | ||
| 212 | (defun pmail-probe (prog) | 249 | (defun pmail-probe (prog) |
| 213 | "Determine what flavor of movemail PROG is. | 250 | "Determine what flavor of movemail PROG is. |
| @@ -311,7 +348,7 @@ It is useful to set this variable in the site customization file.") | |||
| 311 | "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:" | 348 | "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:" |
| 312 | "\\|^mbox-line:\\|^cancel-lock:\\|^DomainKey-Signature:" | 349 | "\\|^mbox-line:\\|^cancel-lock:\\|^DomainKey-Signature:" |
| 313 | "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" | 350 | "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" |
| 314 | "\\|^x-.*:\\|^domainkey-signature:\\|^original-recipient:\\|^from ") | 351 | "\\|^x-.*:") |
| 315 | "*Regexp to match header fields that Pmail should normally hide. | 352 | "*Regexp to match header fields that Pmail should normally hide. |
| 316 | \(See also `pmail-nonignored-headers', which overrides this regexp.) | 353 | \(See also `pmail-nonignored-headers', which overrides this regexp.) |
| 317 | This variable is used for reformatting the message header, | 354 | This variable is used for reformatting the message header, |
| @@ -355,8 +392,7 @@ If nil, display all header fields except those matched by | |||
| 355 | ;;;###autoload | 392 | ;;;###autoload |
| 356 | (defcustom pmail-highlighted-headers "^From:\\|^Subject:" "\ | 393 | (defcustom pmail-highlighted-headers "^From:\\|^Subject:" "\ |
| 357 | *Regexp to match Header fields that Pmail should normally highlight. | 394 | *Regexp to match Header fields that Pmail should normally highlight. |
| 358 | A value of nil means don't highlight. | 395 | A value of nil means don't highlight." |
| 359 | See also `pmail-highlight-face'." | ||
| 360 | :type 'regexp | 396 | :type 'regexp |
| 361 | :group 'pmail-headers) | 397 | :group 'pmail-headers) |
| 362 | 398 | ||
| @@ -373,14 +409,6 @@ See also `pmail-highlight-face'." | |||
| 373 | :version "23.1") | 409 | :version "23.1") |
| 374 | 410 | ||
| 375 | ;;;###autoload | 411 | ;;;###autoload |
| 376 | (defcustom pmail-highlight-face 'pmail-highlight "\ | ||
| 377 | *Face used by Pmail for highlighting sender and subject. | ||
| 378 | See `pmail-font-lock-keywords'." | ||
| 379 | :type '(choice (const :tag "Default" nil) | ||
| 380 | face) | ||
| 381 | :group 'pmail-headers) | ||
| 382 | |||
| 383 | ;;;###autoload | ||
| 384 | (defcustom pmail-delete-after-output nil "\ | 412 | (defcustom pmail-delete-after-output nil "\ |
| 385 | *Non-nil means automatically delete a message that is copied to a file." | 413 | *Non-nil means automatically delete a message that is copied to a file." |
| 386 | :type 'boolean | 414 | :type 'boolean |
| @@ -403,22 +431,6 @@ and the value of the environment variable MAIL overrides it)." | |||
| 403 | :group 'pmail-files) | 431 | :group 'pmail-files) |
| 404 | 432 | ||
| 405 | ;;;###autoload | 433 | ;;;###autoload |
| 406 | (defcustom pmail-inbox-alist nil | ||
| 407 | "*Alist of mail files and backup directory names. | ||
| 408 | Each element has the form (MAIL-FILE INBOX ...). When running | ||
| 409 | pmail on MAIL-FILE, mails in all the INBOX files listed will be | ||
| 410 | moved to the MAIL-FILE. Be sure to fully qualify your MAIL-FILE. | ||
| 411 | |||
| 412 | Example setting if procmail delivers all your spam to | ||
| 413 | ~/Mail/SPAM.in and you read it from the file ~/Mail/SPAM: | ||
| 414 | |||
| 415 | \(setq pmail-inbox-alist '((\"~/Mail/SPAM\" \"~/Mail/SPAM.in\")))" | ||
| 416 | :type '(alist :key-type file :value-type (repeat file)) | ||
| 417 | :group 'pmail-retrieve | ||
| 418 | :group 'pmail-files | ||
| 419 | :version "22.1") | ||
| 420 | |||
| 421 | ;;;###autoload | ||
| 422 | (defcustom pmail-mail-new-frame nil | 434 | (defcustom pmail-mail-new-frame nil |
| 423 | "*Non-nil means Pmail makes a new frame for composing outgoing mail. | 435 | "*Non-nil means Pmail makes a new frame for composing outgoing mail. |
| 424 | This is handy if you want to preserve the window configuration of | 436 | This is handy if you want to preserve the window configuration of |
| @@ -493,9 +505,8 @@ Each element of the list is of the form: | |||
| 493 | 505 | ||
| 494 | (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) | 506 | (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) |
| 495 | 507 | ||
| 496 | Where FOLDERNAME is the name of a BABYL Version 6 (also known as mbox | 508 | Where FOLDERNAME is the name of a BABYL format folder to put the |
| 497 | or Unix inbox format) folder to put the message. If any of the field | 509 | message. If any of the field regexp's are nil, then it is ignored. |
| 498 | regexp's are nil, then it is ignored. | ||
| 499 | 510 | ||
| 500 | If FOLDERNAME is \"/dev/null\", it is deleted. | 511 | If FOLDERNAME is \"/dev/null\", it is deleted. |
| 501 | If FOLDERNAME is nil then it is deleted, and skipped. | 512 | If FOLDERNAME is nil then it is deleted, and skipped. |
| @@ -549,6 +560,18 @@ In a summary buffer, this holds the PMAIL buffer it is a summary for.") | |||
| 549 | (defvar pmail-total-messages nil) | 560 | (defvar pmail-total-messages nil) |
| 550 | (put 'pmail-total-messages 'permanent-local t) | 561 | (put 'pmail-total-messages 'permanent-local t) |
| 551 | 562 | ||
| 563 | (defvar pmail-message-vector nil) | ||
| 564 | (put 'pmail-message-vector 'permanent-local t) | ||
| 565 | |||
| 566 | (defvar pmail-deleted-vector nil) | ||
| 567 | (put 'pmail-deleted-vector 'permanent-local t) | ||
| 568 | |||
| 569 | (defvar pmail-msgref-vector nil | ||
| 570 | "In an Pmail buffer, a vector whose Nth element is a list (N). | ||
| 571 | When expunging renumbers messages, these lists are modified | ||
| 572 | by substituting the new message number into the existing list.") | ||
| 573 | (put 'pmail-msgref-vector 'permanent-local t) | ||
| 574 | |||
| 552 | (defvar pmail-overlay-list nil) | 575 | (defvar pmail-overlay-list nil) |
| 553 | (put 'pmail-overlay-list 'permanent-local t) | 576 | (put 'pmail-overlay-list 'permanent-local t) |
| 554 | 577 | ||
| @@ -556,6 +579,8 @@ In a summary buffer, this holds the PMAIL buffer it is a summary for.") | |||
| 556 | 579 | ||
| 557 | (defvar pmail-summary-buffer nil) | 580 | (defvar pmail-summary-buffer nil) |
| 558 | (put 'pmail-summary-buffer 'permanent-local t) | 581 | (put 'pmail-summary-buffer 'permanent-local t) |
| 582 | (defvar pmail-summary-vector nil) | ||
| 583 | (put 'pmail-summary-vector 'permanent-local t) | ||
| 559 | 584 | ||
| 560 | (defvar pmail-view-buffer nil | 585 | (defvar pmail-view-buffer nil |
| 561 | "Buffer which holds PMAIL message for MIME displaying.") | 586 | "Buffer which holds PMAIL message for MIME displaying.") |
| @@ -577,12 +602,10 @@ In a summary buffer, this holds the PMAIL buffer it is a summary for.") | |||
| 577 | "*Default file name for \\[pmail-output]." | 602 | "*Default file name for \\[pmail-output]." |
| 578 | :type 'file | 603 | :type 'file |
| 579 | :group 'pmail-files) | 604 | :group 'pmail-files) |
| 580 | |||
| 581 | (defcustom pmail-default-pmail-file "~/XMAIL" | 605 | (defcustom pmail-default-pmail-file "~/XMAIL" |
| 582 | "*Default file name for \\[pmail-output-to-pmail-file]." | 606 | "*Default file name for \\[pmail-output-to-pmail-file]." |
| 583 | :type 'file | 607 | :type 'file |
| 584 | :group 'pmail-files) | 608 | :group 'pmail-files) |
| 585 | |||
| 586 | (defcustom pmail-default-body-file "~/mailout" | 609 | (defcustom pmail-default-body-file "~/mailout" |
| 587 | "*Default file name for \\[pmail-output-body-to-file]." | 610 | "*Default file name for \\[pmail-output-body-to-file]." |
| 588 | :type 'file | 611 | :type 'file |
| @@ -683,8 +706,9 @@ The first parenthesized expression should match the MIME-charset name.") | |||
| 683 | 706 | ||
| 684 | 707 | ||
| 685 | ;;; Regexp matching the delimiter of messages in UNIX mail format | 708 | ;;; Regexp matching the delimiter of messages in UNIX mail format |
| 686 | ;;; (UNIX From lines), with an initial ^. Used in pmail-decode-from-line, | 709 | ;;; (UNIX From lines), minus the initial ^. Note that if you change |
| 687 | ;;; which knows the exact ordering of the \\(...\\) subexpressions. | 710 | ;;; this expression, you must change the code in pmail-nuke-pinhead-header |
| 711 | ;;; that knows the exact ordering of the \\( \\) subexpressions. | ||
| 688 | (defvar pmail-unix-mail-delimiter | 712 | (defvar pmail-unix-mail-delimiter |
| 689 | (let ((time-zone-regexp | 713 | (let ((time-zone-regexp |
| 690 | (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" | 714 | (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" |
| @@ -692,7 +716,7 @@ The first parenthesized expression should match the MIME-charset name.") | |||
| 692 | "\\|" | 716 | "\\|" |
| 693 | "\\) *"))) | 717 | "\\) *"))) |
| 694 | (concat | 718 | (concat |
| 695 | "^From " | 719 | "From " |
| 696 | 720 | ||
| 697 | ;; Many things can happen to an RFC 822 mailbox before it is put into | 721 | ;; Many things can happen to an RFC 822 mailbox before it is put into |
| 698 | ;; a `From' line. The leading phrase can be stripped, e.g. | 722 | ;; a `From' line. The leading phrase can be stripped, e.g. |
| @@ -743,18 +767,13 @@ The first parenthesized expression should match the MIME-charset name.") | |||
| 743 | (let* ((cite-chars "[>|}]") | 767 | (let* ((cite-chars "[>|}]") |
| 744 | (cite-prefix "a-z") | 768 | (cite-prefix "a-z") |
| 745 | (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) | 769 | (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) |
| 746 | (list '("^\\(Sender\\|Resent-From\\):" | 770 | (list '("^\\(From\\|Sender\\|Resent-From\\):" |
| 747 | . font-lock-function-name-face) | 771 | . 'pmail-header-name) |
| 748 | '("^Reply-To:.*$" . font-lock-function-name-face) | 772 | '("^Reply-To:.*$" . 'pmail-header-name) |
| 749 | '("^\\(From:\\)\\(.*\\(\n[ \t]+.*\\)*\\)" | 773 | '("^Subject:" . 'pmail-header-name) |
| 750 | (1 font-lock-function-name-face) | 774 | '("^X-Spam-Status:" . 'pmail-header-name) |
| 751 | (2 pmail-highlight-face)) | ||
| 752 | '("^\\(Subject:\\)\\(.*\\(\n[ \t]+.*\\)*\\)" | ||
| 753 | (1 font-lock-comment-face) | ||
| 754 | (2 pmail-highlight-face)) | ||
| 755 | '("^X-Spam-Status:" . font-lock-keyword-face) | ||
| 756 | '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" | 775 | '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" |
| 757 | . font-lock-keyword-face) | 776 | . 'pmail-header-name) |
| 758 | ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. | 777 | ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. |
| 759 | `(,cite-chars | 778 | `(,cite-chars |
| 760 | (,(concat "\\=[ \t]*" | 779 | (,(concat "\\=[ \t]*" |
| @@ -798,11 +817,6 @@ The first parenthesized expression should match the MIME-charset name.") | |||
| 798 | 817 | ||
| 799 | (defvar pmail-enable-multibyte nil) | 818 | (defvar pmail-enable-multibyte nil) |
| 800 | 819 | ||
| 801 | ;; XXX rmail-spam-filter hasn't been tested at all with the mbox | ||
| 802 | ;; branch. --enberg | ||
| 803 | (defvar pmail-use-spam-filter nil | ||
| 804 | "*Non-nil to activate the rmail spam filter with pmail. | ||
| 805 | WARNING - this has not been tested at all with pmail.") | ||
| 806 | 820 | ||
| 807 | (defun pmail-require-mime-maybe () | 821 | (defun pmail-require-mime-maybe () |
| 808 | "Require `pmail-mime-feature' if that is non-nil. | 822 | "Require `pmail-mime-feature' if that is non-nil. |
| @@ -822,6 +836,7 @@ So, the MIME support is turned off for the moment." | |||
| 822 | pmail-mime-feature)) | 836 | pmail-mime-feature)) |
| 823 | (setq pmail-enable-mime nil))))) | 837 | (setq pmail-enable-mime nil))))) |
| 824 | 838 | ||
| 839 | |||
| 825 | ;;;###autoload | 840 | ;;;###autoload |
| 826 | (defun pmail (&optional file-name-arg) | 841 | (defun pmail (&optional file-name-arg) |
| 827 | "Read and edit incoming mail. | 842 | "Read and edit incoming mail. |
| @@ -849,239 +864,339 @@ If `pmail-display-summary' is non-nil, make a summary for this PMAIL file." | |||
| 849 | (if existed | 864 | (if existed |
| 850 | (with-current-buffer existed enable-multibyte-characters) | 865 | (with-current-buffer existed enable-multibyte-characters) |
| 851 | (default-value 'enable-multibyte-characters))) | 866 | (default-value 'enable-multibyte-characters))) |
| 867 | ;; Since the file may contain messages of different encodings | ||
| 868 | ;; at the tail (non-BYBYL part), we can't decode them at once | ||
| 869 | ;; on reading. So, at first, we read the file without text | ||
| 870 | ;; code conversion, then decode the messages one by one by | ||
| 871 | ;; pmail-decode-babyl-format or | ||
| 872 | ;; pmail-convert-to-babyl-format. | ||
| 873 | (coding-system-for-read (and pmail-enable-multibyte 'raw-text)) | ||
| 852 | run-mail-hook msg-shown) | 874 | run-mail-hook msg-shown) |
| 853 | (when (and existed (eq major-mode 'pmail-edit-mode)) | 875 | ;; Like find-file, but in the case where a buffer existed |
| 854 | (error "Exit Pmail Edit mode before getting new mail")) | 876 | ;; and the file was reverted, recompute the message-data. |
| 877 | ;; We used to bind enable-local-variables to nil here, | ||
| 878 | ;; but that should not be needed now that pmail-mode | ||
| 879 | ;; sets it locally to nil. | ||
| 880 | ;; (Binding a variable locally with let is not safe if it has | ||
| 881 | ;; buffer-local bindings.) | ||
| 855 | (if (and existed (not (verify-visited-file-modtime existed))) | 882 | (if (and existed (not (verify-visited-file-modtime existed))) |
| 856 | (progn | 883 | (progn |
| 857 | (find-file file-name) | 884 | (find-file file-name) |
| 858 | (when (and (verify-visited-file-modtime existed) | 885 | (when (and (verify-visited-file-modtime existed) |
| 859 | (eq major-mode 'pmail-mode)) | 886 | (eq major-mode 'pmail-mode)) |
| 860 | (setq major-mode 'fundamental-mode))) | 887 | (pmail-forget-messages) |
| 861 | (switch-to-buffer | 888 | (pmail-set-message-counters))) |
| 862 | (let ((enable-local-variables nil)) | 889 | (switch-to-buffer |
| 863 | (find-file-noselect file-name))) | 890 | (let ((enable-local-variables nil)) |
| 864 | ;; As we have read a file as raw-text, the buffer is set to | 891 | (find-file-noselect file-name)))) |
| 865 | ;; unibyte. We must make it multibyte if necessary. | 892 | (setq pmail-buffers-swapped-p nil) |
| 866 | (when (and pmail-enable-multibyte | 893 | (if (eq major-mode 'pmail-edit-mode) |
| 867 | (not enable-multibyte-characters)) | 894 | (error "Exit Pmail Edit mode before getting new mail")) |
| 868 | (set-buffer-multibyte t))) | 895 | (if (and existed (> (buffer-size) 0)) |
| 869 | ;; Make sure we're in pmail-mode, even if the buffer did exist and | 896 | ;; Buffer not new and not empty; ensure in proper mode, but that's all. |
| 870 | ;; the file was not changed. | 897 | (or (eq major-mode 'pmail-mode) |
| 871 | (unless (eq major-mode 'pmail-mode) | 898 | (progn (pmail-mode-2) |
| 872 | ;; If file looks like a Babyl file, save it to a temp file, | 899 | (setq run-mail-hook t))) |
| 873 | ;; convert it, and replace the current content with the | ||
| 874 | ;; converted content. Don't save -- let the user do it. | ||
| 875 | (goto-char (point-min)) | ||
| 876 | (when (looking-at "BABYL OPTIONS:") | ||
| 877 | (let ((old-file (make-temp-file "pmail")) | ||
| 878 | (new-file (make-temp-file "pmail"))) | ||
| 879 | (unwind-protect | ||
| 880 | (progn | ||
| 881 | (write-region (point-min) (point-max) old-file) | ||
| 882 | (unrmail old-file new-file) | ||
| 883 | (message "Replacing BABYL format with mbox format...") | ||
| 884 | (let ((inhibit-read-only t)) | ||
| 885 | (erase-buffer) | ||
| 886 | (insert-file-contents-literally new-file)) | ||
| 887 | (message "Replacing BABYL format with mbox format...done")) | ||
| 888 | (delete-file old-file) | ||
| 889 | (delete-file new-file)))) | ||
| 890 | (goto-char (point-max)) | ||
| 891 | (pmail-mode-2) | ||
| 892 | ;; Convert all or parts of file to a format Pmail understands | ||
| 893 | (pmail-convert-file) | ||
| 894 | ;; We use `run-mail-hook' to remember whether we should run | ||
| 895 | ;; `pmail-mode-hook' at the end. | ||
| 896 | (setq run-mail-hook t) | 900 | (setq run-mail-hook t) |
| 897 | ;; Initialize the Pmail state. | 901 | (pmail-mode-2) |
| 898 | (pmail-initialize-messages)) | 902 | (pmail-convert-file-maybe) |
| 899 | ;; Now we're back in business. The happens even if we had a | 903 | (goto-char (point-max))) |
| 900 | ;; perfectly fine file. | 904 | ;; As we have read a file by raw-text, the buffer is set to |
| 905 | ;; unibyte. We must make it multibyte if necessary. | ||
| 906 | (if (and pmail-enable-multibyte | ||
| 907 | (not enable-multibyte-characters)) | ||
| 908 | (set-buffer-multibyte t)) | ||
| 909 | ;; If necessary, scan to find all the messages. | ||
| 910 | (pmail-maybe-set-message-counters) | ||
| 901 | (unwind-protect | 911 | (unwind-protect |
| 902 | (unless (and (not file-name-arg) (pmail-get-new-mail)) | 912 | (unless (and (not file-name-arg) (pmail-get-new-mail)) |
| 903 | (pmail-show-message (pmail-first-unseen-message))) | 913 | (pmail-show-message (pmail-first-unseen-message))) |
| 904 | (when pmail-display-summary | 914 | (progn |
| 905 | (pmail-summary)) | 915 | (if pmail-display-summary (pmail-summary)) |
| 906 | (pmail-construct-io-menu) | 916 | (pmail-construct-io-menu) |
| 907 | ;; Run any callbacks if the buffer was not in pmail-mode | 917 | (if run-mail-hook |
| 908 | (when run-mail-hook | 918 | (run-hooks 'pmail-mode-hook)))))) |
| 909 | (run-hooks 'pmail-mode-hook))))) | 919 | |
| 910 | 920 | ;; Given the value of MAILPATH, return a list of inbox file names. | |
| 911 | (defun pmail-convert-file () | 921 | ;; This is turned off because it is not clear that the user wants |
| 912 | "Convert unconverted messages. | 922 | ;; all these inboxes to feed into the primary pmail file. |
| 913 | A message is unconverted if it doesn't have the BABYL header | 923 | ; (defun pmail-convert-mailpath (string) |
| 914 | specified in `pmail-header-attribute-header'; it is converted | 924 | ; (let (idx list) |
| 915 | using `pmail-convert-mbox-format'." | 925 | ; (while (setq idx (string-match "[%:]" string)) |
| 916 | (let ((convert | 926 | ; (let ((this (substring string 0 idx))) |
| 917 | (save-restriction | 927 | ; (setq string (substring string (1+ idx))) |
| 918 | (widen) | 928 | ; (setq list (cons (if (string-match "%" this) |
| 919 | (let ((case-fold-search nil) | 929 | ; (substring this 0 (string-match "%" this)) |
| 920 | (start (point-max)) | 930 | ; this) |
| 921 | end) | 931 | ; list)))) |
| 922 | (catch 'convert | 932 | ; list)) |
| 923 | (goto-char start) | 933 | |
| 924 | (while (re-search-backward | 934 | ; I have checked that adding "-*- pmail -*-" to the BABYL OPTIONS line |
| 925 | pmail-unix-mail-delimiter nil t) | 935 | ; will not cause emacs 18.55 problems. |
| 926 | (setq end start) | 936 | |
| 927 | (setq start (point)) | 937 | ;; This calls pmail-decode-babyl-format if the file is already Babyl. |
| 928 | (save-excursion | 938 | |
| 929 | (save-restriction | 939 | (defun pmail-convert-file-maybe () |
| 930 | (narrow-to-region start end) | 940 | "Determine if the file needs to be converted to mbox format." |
| 931 | (goto-char start) | ||
| 932 | (let ((attribute (pmail-header-get-header | ||
| 933 | pmail-header-attribute-header))) | ||
| 934 | (unless attribute | ||
| 935 | (throw 'convert t))))))))))) | ||
| 936 | (if convert | ||
| 937 | (let ((inhibit-read-only t)) | ||
| 938 | (pmail-convert-mbox-format))))) | ||
| 939 | |||
| 940 | (defun pmail-initialize-messages () | ||
| 941 | "Initialize message state based on messages in the buffer." | ||
| 942 | (setq pmail-total-messages 0 | ||
| 943 | pmail-current-message 1) | ||
| 944 | (pmail-desc-clear-descriptors) | ||
| 945 | (widen) | 941 | (widen) |
| 946 | (pmail-header-show-headers) | 942 | (goto-char (point-min)) |
| 947 | (setq pmail-total-messages (pmail-process-new-messages))) | 943 | ;; Detect previous Babyl format files. |
| 948 | 944 | (cond ((looking-at "BABYL OPTIONS:") | |
| 949 | (defvar pmail-mode-map | 945 | ;; The file is Babyl version 5. Use unrmail to convert |
| 950 | (let ((map (make-sparse-keymap))) | 946 | ;; it. |
| 951 | (suppress-keymap map) | 947 | (pmail-convert-babyl-to-mbox)) |
| 952 | (define-key map "a" 'pmail-add-label) | 948 | ((looking-at "Version: 5\n") |
| 953 | (define-key map "b" 'pmail-bury) | 949 | ;; Losing babyl file made by old version of Pmail. Fix the |
| 954 | (define-key map "c" 'pmail-continue) | 950 | ;; babyl file header and use unrmail to convert to mbox |
| 955 | (define-key map "d" 'pmail-delete-forward) | 951 | ;; format. |
| 956 | (define-key map "\C-d" 'pmail-delete-backward) | 952 | (let ((buffer-read-only nil)) |
| 957 | (define-key map "e" 'pmail-edit-current-message) | 953 | (insert "BABYL OPTIONS: -*- pmail -*-\n") |
| 958 | (define-key map "f" 'pmail-forward) | 954 | (pmail-convert-babyl-to-mbox))) |
| 959 | (define-key map "g" 'pmail-get-new-mail) | 955 | ((equal (point-min) (point-max)) |
| 960 | (define-key map "h" 'pmail-summary) | 956 | (message "Empty Pmail file.")) |
| 961 | (define-key map "i" 'pmail-input) | 957 | ((looking-at "From ")) |
| 962 | (define-key map "j" 'pmail-show-message) | 958 | (t (error "Invalid mbox format mail file.")))) |
| 963 | (define-key map "k" 'pmail-kill-label) | 959 | |
| 964 | (define-key map "l" 'pmail-summary-by-labels) | 960 | (defun pmail-convert-babyl-to-mbox () |
| 965 | (define-key map "\e\C-h" 'pmail-summary) | 961 | "Convert the mail file from Babyl version 5 to mbox." |
| 966 | (define-key map "\e\C-l" 'pmail-summary-by-labels) | 962 | (let ((old-file (make-temp-file "pmail")) |
| 967 | (define-key map "\e\C-r" 'pmail-summary-by-recipients) | 963 | (new-file (make-temp-file "pmail"))) |
| 968 | (define-key map "\e\C-s" 'pmail-summary-by-regexp) | 964 | (unwind-protect |
| 969 | (define-key map "\e\C-t" 'pmail-summary-by-topic) | 965 | (progn |
| 970 | (define-key map "m" 'pmail-mail) | 966 | (write-region (point-min) (point-max) old-file) |
| 971 | (define-key map "\em" 'pmail-retry-failure) | 967 | (unrmail old-file new-file) |
| 972 | (define-key map "n" 'pmail-next-undeleted-message) | 968 | (message "Replacing BABYL format with mbox format...") |
| 973 | (define-key map "\en" 'pmail-next-message) | 969 | (let ((inhibit-read-only t)) |
| 974 | (define-key map "\e\C-n" 'pmail-next-labeled-message) | 970 | (erase-buffer) |
| 975 | (define-key map "o" 'pmail-output) | 971 | (insert-file-contents-literally new-file)) |
| 976 | (define-key map "\C-o" 'pmail-output) | 972 | (message "Replacing BABYL format with mbox format...done")) |
| 977 | (define-key map "p" 'pmail-previous-undeleted-message) | 973 | (delete-file old-file) |
| 978 | (define-key map "\ep" 'pmail-previous-message) | 974 | (delete-file new-file)))) |
| 979 | (define-key map "\e\C-p" 'pmail-previous-labeled-message) | 975 | |
| 980 | (define-key map "q" 'pmail-quit) | 976 | (defun pmail-insert-pmail-file-header () |
| 981 | (define-key map "r" 'pmail-reply) | 977 | (let ((buffer-read-only nil)) |
| 982 | ;; I find I can't live without the default M-r command -- rms. | 978 | ;; -*-pmail-*- is here so that visiting the file normally |
| 983 | ;; (define-key map "\er" 'pmail-search-backwards) | 979 | ;; recognizes it as an Pmail file. |
| 984 | (define-key map "s" 'pmail-expunge-and-save) | 980 | (insert "BABYL OPTIONS: -*- pmail -*- |
| 985 | (define-key map "\es" 'pmail-search) | 981 | Version: 5 |
| 986 | (define-key map "t" 'pmail-toggle-header) | 982 | Labels: |
| 987 | (define-key map "u" 'pmail-undelete-previous-message) | 983 | Note: This is the header of an pmail file. |
| 988 | (define-key map "w" 'pmail-output-body-to-file) | 984 | Note: If you are seeing it in pmail, |
| 989 | (define-key map "x" 'pmail-expunge) | 985 | Note: it means the file has no messages in it.\n\^_"))) |
| 990 | (define-key map "." 'pmail-beginning-of-message) | 986 | |
| 991 | (define-key map "/" 'pmail-end-of-message) | 987 | ;; Decode Babyl formatted part at the head of current buffer by |
| 992 | (define-key map "<" 'pmail-first-message) | 988 | ;; pmail-file-coding-system, or if it is nil, do auto conversion. |
| 993 | (define-key map ">" 'pmail-last-message) | 989 | |
| 994 | (define-key map " " 'scroll-up) | 990 | (defun pmail-decode-babyl-format () |
| 995 | (define-key map "\177" 'scroll-down) | 991 | (let ((modifiedp (buffer-modified-p)) |
| 996 | (define-key map "?" 'describe-mode) | 992 | (buffer-read-only nil) |
| 997 | (define-key map "\C-c\C-s\C-d" 'pmail-sort-by-date) | 993 | (coding-system pmail-file-coding-system) |
| 998 | (define-key map "\C-c\C-s\C-s" 'pmail-sort-by-subject) | 994 | from to) |
| 999 | (define-key map "\C-c\C-s\C-a" 'pmail-sort-by-author) | 995 | (goto-char (point-min)) |
| 1000 | (define-key map "\C-c\C-s\C-r" 'pmail-sort-by-recipient) | 996 | (search-forward "\n\^_" nil t) ; Skip BABYL header. |
| 1001 | (define-key map "\C-c\C-s\C-c" 'pmail-sort-by-correspondent) | 997 | (setq from (point)) |
| 1002 | (define-key map "\C-c\C-s\C-l" 'pmail-sort-by-lines) | 998 | (goto-char (point-max)) |
| 1003 | (define-key map "\C-c\C-s\C-k" 'pmail-sort-by-labels) | 999 | (search-backward "\n\^_" from 'mv) |
| 1004 | (define-key map "\C-c\C-n" 'pmail-next-same-subject) | 1000 | (setq to (point)) |
| 1005 | (define-key map "\C-c\C-p" 'pmail-previous-same-subject) | 1001 | (unless (and coding-system |
| 1006 | (define-key map [menu-bar] (make-sparse-keymap)) | 1002 | (coding-system-p coding-system)) |
| 1007 | (define-key map [menu-bar classify] | 1003 | (setq coding-system |
| 1008 | (cons "Classify" (make-sparse-keymap "Classify"))) | 1004 | ;; If pmail-file-coding-system is nil, Emacs 21 writes |
| 1009 | (define-key map [menu-bar classify input-menu] | 1005 | ;; PMAIL files in emacs-mule, Emacs 22 in utf-8, but |
| 1010 | nil) | 1006 | ;; earlier versions did that with the current buffer's |
| 1011 | (define-key map [menu-bar classify output-menu] | 1007 | ;; encoding. So we want to favor detection of emacs-mule |
| 1012 | nil) | 1008 | ;; (whose normal priority is quite low) and utf-8, but |
| 1013 | (define-key map [menu-bar classify output-body] | 1009 | ;; still allow detection of other encodings if they won't |
| 1014 | '("Output body to file..." . pmail-output-body-to-file)) | 1010 | ;; fit. The call to with-coding-priority below achieves |
| 1015 | (define-key map [menu-bar classify output-inbox] | 1011 | ;; that. |
| 1016 | '("Output (inbox)..." . pmail-output)) | 1012 | (with-coding-priority '(emacs-mule utf-8) |
| 1017 | (define-key map [menu-bar classify output] | 1013 | (detect-coding-region from to 'highest)))) |
| 1018 | '("Output (Pmail)..." . pmail-output)) | 1014 | (unless (eq (coding-system-type coding-system) 'undecided) |
| 1019 | (define-key map [menu-bar classify kill-label] | 1015 | (set-buffer-modified-p t) ; avoid locking when decoding |
| 1020 | '("Kill Label..." . pmail-kill-label)) | 1016 | (let ((buffer-undo-list t)) |
| 1021 | (define-key map [menu-bar classify add-label] | 1017 | (decode-coding-region from to coding-system)) |
| 1022 | '("Add Label..." . pmail-add-label)) | 1018 | (setq coding-system last-coding-system-used)) |
| 1023 | (define-key map [menu-bar summary] | 1019 | (set-buffer-modified-p modifiedp) |
| 1024 | (cons "Summary" (make-sparse-keymap "Summary"))) | 1020 | (setq buffer-file-coding-system nil) |
| 1025 | (define-key map [menu-bar summary senders] | 1021 | (setq save-buffer-coding-system |
| 1026 | '("By Senders..." . pmail-summary-by-senders)) | 1022 | (or coding-system 'undecided)))) |
| 1027 | (define-key map [menu-bar summary labels] | 1023 | |
| 1028 | '("By Labels..." . pmail-summary-by-labels)) | 1024 | (defvar pmail-mode-map nil) |
| 1029 | (define-key map [menu-bar summary recipients] | 1025 | (if pmail-mode-map |
| 1030 | '("By Recipients..." . pmail-summary-by-recipients)) | 1026 | nil |
| 1031 | (define-key map [menu-bar summary topic] | 1027 | (setq pmail-mode-map (make-keymap)) |
| 1032 | '("By Topic..." . pmail-summary-by-topic)) | 1028 | (suppress-keymap pmail-mode-map) |
| 1033 | (define-key map [menu-bar summary regexp] | 1029 | (define-key pmail-mode-map "a" 'pmail-add-label) |
| 1034 | '("By Regexp..." . pmail-summary-by-regexp)) | 1030 | (define-key pmail-mode-map "b" 'pmail-bury) |
| 1035 | (define-key map [menu-bar summary all] | 1031 | (define-key pmail-mode-map "c" 'pmail-continue) |
| 1036 | '("All" . pmail-summary)) | 1032 | (define-key pmail-mode-map "d" 'pmail-delete-forward) |
| 1037 | (define-key map [menu-bar mail] | 1033 | (define-key pmail-mode-map "\C-d" 'pmail-delete-backward) |
| 1038 | (cons "Mail" (make-sparse-keymap "Mail"))) | 1034 | (define-key pmail-mode-map "e" 'pmail-edit-current-message) |
| 1039 | (define-key map [menu-bar mail pmail-get-new-mail] | 1035 | (define-key pmail-mode-map "f" 'pmail-forward) |
| 1040 | '("Get New Mail" . pmail-get-new-mail)) | 1036 | (define-key pmail-mode-map "g" 'pmail-get-new-mail) |
| 1041 | (define-key map [menu-bar mail lambda] | 1037 | (define-key pmail-mode-map "h" 'pmail-summary) |
| 1042 | '("----")) | 1038 | (define-key pmail-mode-map "i" 'pmail-input) |
| 1043 | (define-key map [menu-bar mail continue] | 1039 | (define-key pmail-mode-map "j" 'pmail-show-message) |
| 1044 | '("Continue" . pmail-continue)) | 1040 | (define-key pmail-mode-map "k" 'pmail-kill-label) |
| 1045 | (define-key map [menu-bar mail resend] | 1041 | (define-key pmail-mode-map "l" 'pmail-summary-by-labels) |
| 1046 | '("Re-send..." . pmail-resend)) | 1042 | (define-key pmail-mode-map "\e\C-h" 'pmail-summary) |
| 1047 | (define-key map [menu-bar mail forward] | 1043 | (define-key pmail-mode-map "\e\C-l" 'pmail-summary-by-labels) |
| 1048 | '("Forward" . pmail-forward)) | 1044 | (define-key pmail-mode-map "\e\C-r" 'pmail-summary-by-recipients) |
| 1049 | (define-key map [menu-bar mail retry] | 1045 | (define-key pmail-mode-map "\e\C-s" 'pmail-summary-by-regexp) |
| 1050 | '("Retry" . pmail-retry-failure)) | 1046 | (define-key pmail-mode-map "\e\C-t" 'pmail-summary-by-topic) |
| 1051 | (define-key map [menu-bar mail reply] | 1047 | (define-key pmail-mode-map "m" 'pmail-mail) |
| 1052 | '("Reply" . pmail-reply)) | 1048 | (define-key pmail-mode-map "\em" 'pmail-retry-failure) |
| 1053 | (define-key map [menu-bar mail mail] | 1049 | (define-key pmail-mode-map "n" 'pmail-next-undeleted-message) |
| 1054 | '("Mail" . pmail-mail)) | 1050 | (define-key pmail-mode-map "\en" 'pmail-next-message) |
| 1055 | (define-key map [menu-bar delete] | 1051 | (define-key pmail-mode-map "\e\C-n" 'pmail-next-labeled-message) |
| 1056 | (cons "Delete" (make-sparse-keymap "Delete"))) | 1052 | (define-key pmail-mode-map "o" 'pmail-output-to-pmail-file) |
| 1057 | (define-key map [menu-bar delete expunge/save] | 1053 | (define-key pmail-mode-map "\C-o" 'pmail-output) |
| 1058 | '("Expunge/Save" . pmail-expunge-and-save)) | 1054 | (define-key pmail-mode-map "p" 'pmail-previous-undeleted-message) |
| 1059 | (define-key map [menu-bar delete expunge] | 1055 | (define-key pmail-mode-map "\ep" 'pmail-previous-message) |
| 1060 | '("Expunge" . pmail-expunge)) | 1056 | (define-key pmail-mode-map "\e\C-p" 'pmail-previous-labeled-message) |
| 1061 | (define-key map [menu-bar delete undelete] | 1057 | (define-key pmail-mode-map "q" 'pmail-quit) |
| 1062 | '("Undelete" . pmail-undelete-previous-message)) | 1058 | (define-key pmail-mode-map "r" 'pmail-reply) |
| 1063 | (define-key map [menu-bar delete delete] | 1059 | ;; I find I can't live without the default M-r command -- rms. |
| 1064 | '("Delete" . pmail-delete-forward)) | 1060 | ;; (define-key pmail-mode-map "\er" 'pmail-search-backwards) |
| 1065 | (define-key map [menu-bar move] | 1061 | (define-key pmail-mode-map "s" 'pmail-expunge-and-save) |
| 1066 | (cons "Move" (make-sparse-keymap "Move"))) | 1062 | (define-key pmail-mode-map "\es" 'pmail-search) |
| 1067 | (define-key map [menu-bar move search-back] | 1063 | (define-key pmail-mode-map "t" 'pmail-toggle-header) |
| 1068 | '("Search Back..." . pmail-search-backwards)) | 1064 | (define-key pmail-mode-map "u" 'pmail-undelete-previous-message) |
| 1069 | (define-key map [menu-bar move search] | 1065 | (define-key pmail-mode-map "w" 'pmail-output-body-to-file) |
| 1070 | '("Search..." . pmail-search)) | 1066 | (define-key pmail-mode-map "x" 'pmail-expunge) |
| 1071 | (define-key map [menu-bar move previous] | 1067 | (define-key pmail-mode-map "." 'pmail-beginning-of-message) |
| 1072 | '("Previous Nondeleted" . pmail-previous-undeleted-message)) | 1068 | (define-key pmail-mode-map "/" 'pmail-end-of-message) |
| 1073 | (define-key map [menu-bar move next] | 1069 | (define-key pmail-mode-map "<" 'pmail-first-message) |
| 1074 | '("Next Nondeleted" . pmail-next-undeleted-message)) | 1070 | (define-key pmail-mode-map ">" 'pmail-last-message) |
| 1075 | (define-key map [menu-bar move last] | 1071 | (define-key pmail-mode-map " " 'scroll-up) |
| 1076 | '("Last" . pmail-last-message)) | 1072 | (define-key pmail-mode-map "\177" 'scroll-down) |
| 1077 | (define-key map [menu-bar move first] | 1073 | (define-key pmail-mode-map "?" 'describe-mode) |
| 1078 | '("First" . pmail-first-message)) | 1074 | (define-key pmail-mode-map "\C-c\C-s\C-d" 'pmail-sort-by-date) |
| 1079 | (define-key map [menu-bar move previous] | 1075 | (define-key pmail-mode-map "\C-c\C-s\C-s" 'pmail-sort-by-subject) |
| 1080 | '("Previous" . pmail-previous-message)) | 1076 | (define-key pmail-mode-map "\C-c\C-s\C-a" 'pmail-sort-by-author) |
| 1081 | (define-key map [menu-bar move next] | 1077 | (define-key pmail-mode-map "\C-c\C-s\C-r" 'pmail-sort-by-recipient) |
| 1082 | '("Next" . pmail-next-message)) | 1078 | (define-key pmail-mode-map "\C-c\C-s\C-c" 'pmail-sort-by-correspondent) |
| 1083 | map) | 1079 | (define-key pmail-mode-map "\C-c\C-s\C-l" 'pmail-sort-by-lines) |
| 1084 | "Keymap for `pmail-mode'.") | 1080 | (define-key pmail-mode-map "\C-c\C-s\C-k" 'pmail-sort-by-labels) |
| 1081 | (define-key pmail-mode-map "\C-c\C-n" 'pmail-next-same-subject) | ||
| 1082 | (define-key pmail-mode-map "\C-c\C-p" 'pmail-previous-same-subject) | ||
| 1083 | ) | ||
| 1084 | |||
| 1085 | (define-key pmail-mode-map [menu-bar] (make-sparse-keymap)) | ||
| 1086 | |||
| 1087 | (define-key pmail-mode-map [menu-bar classify] | ||
| 1088 | (cons "Classify" (make-sparse-keymap "Classify"))) | ||
| 1089 | |||
| 1090 | (define-key pmail-mode-map [menu-bar classify input-menu] | ||
| 1091 | nil) | ||
| 1092 | |||
| 1093 | (define-key pmail-mode-map [menu-bar classify output-menu] | ||
| 1094 | nil) | ||
| 1095 | |||
| 1096 | (define-key pmail-mode-map [menu-bar classify output-body] | ||
| 1097 | '("Output body to file..." . pmail-output-body-to-file)) | ||
| 1098 | |||
| 1099 | (define-key pmail-mode-map [menu-bar classify output-inbox] | ||
| 1100 | '("Output (inbox)..." . pmail-output)) | ||
| 1101 | |||
| 1102 | (define-key pmail-mode-map [menu-bar classify output] | ||
| 1103 | '("Output (Pmail)..." . pmail-output-to-pmail-file)) | ||
| 1104 | |||
| 1105 | (define-key pmail-mode-map [menu-bar classify kill-label] | ||
| 1106 | '("Kill Label..." . pmail-kill-label)) | ||
| 1107 | |||
| 1108 | (define-key pmail-mode-map [menu-bar classify add-label] | ||
| 1109 | '("Add Label..." . pmail-add-label)) | ||
| 1110 | |||
| 1111 | (define-key pmail-mode-map [menu-bar summary] | ||
| 1112 | (cons "Summary" (make-sparse-keymap "Summary"))) | ||
| 1113 | |||
| 1114 | (define-key pmail-mode-map [menu-bar summary senders] | ||
| 1115 | '("By Senders..." . pmail-summary-by-senders)) | ||
| 1116 | |||
| 1117 | (define-key pmail-mode-map [menu-bar summary labels] | ||
| 1118 | '("By Labels..." . pmail-summary-by-labels)) | ||
| 1119 | |||
| 1120 | (define-key pmail-mode-map [menu-bar summary recipients] | ||
| 1121 | '("By Recipients..." . pmail-summary-by-recipients)) | ||
| 1122 | |||
| 1123 | (define-key pmail-mode-map [menu-bar summary topic] | ||
| 1124 | '("By Topic..." . pmail-summary-by-topic)) | ||
| 1125 | |||
| 1126 | (define-key pmail-mode-map [menu-bar summary regexp] | ||
| 1127 | '("By Regexp..." . pmail-summary-by-regexp)) | ||
| 1128 | |||
| 1129 | (define-key pmail-mode-map [menu-bar summary all] | ||
| 1130 | '("All" . pmail-summary)) | ||
| 1131 | |||
| 1132 | (define-key pmail-mode-map [menu-bar mail] | ||
| 1133 | (cons "Mail" (make-sparse-keymap "Mail"))) | ||
| 1134 | |||
| 1135 | (define-key pmail-mode-map [menu-bar mail pmail-get-new-mail] | ||
| 1136 | '("Get New Mail" . pmail-get-new-mail)) | ||
| 1137 | |||
| 1138 | (define-key pmail-mode-map [menu-bar mail lambda] | ||
| 1139 | '("----")) | ||
| 1140 | |||
| 1141 | (define-key pmail-mode-map [menu-bar mail continue] | ||
| 1142 | '("Continue" . pmail-continue)) | ||
| 1143 | |||
| 1144 | (define-key pmail-mode-map [menu-bar mail resend] | ||
| 1145 | '("Re-send..." . pmail-resend)) | ||
| 1146 | |||
| 1147 | (define-key pmail-mode-map [menu-bar mail forward] | ||
| 1148 | '("Forward" . pmail-forward)) | ||
| 1149 | |||
| 1150 | (define-key pmail-mode-map [menu-bar mail retry] | ||
| 1151 | '("Retry" . pmail-retry-failure)) | ||
| 1152 | |||
| 1153 | (define-key pmail-mode-map [menu-bar mail reply] | ||
| 1154 | '("Reply" . pmail-reply)) | ||
| 1155 | |||
| 1156 | (define-key pmail-mode-map [menu-bar mail mail] | ||
| 1157 | '("Mail" . pmail-mail)) | ||
| 1158 | |||
| 1159 | (define-key pmail-mode-map [menu-bar delete] | ||
| 1160 | (cons "Delete" (make-sparse-keymap "Delete"))) | ||
| 1161 | |||
| 1162 | (define-key pmail-mode-map [menu-bar delete expunge/save] | ||
| 1163 | '("Expunge/Save" . pmail-expunge-and-save)) | ||
| 1164 | |||
| 1165 | (define-key pmail-mode-map [menu-bar delete expunge] | ||
| 1166 | '("Expunge" . pmail-expunge)) | ||
| 1167 | |||
| 1168 | (define-key pmail-mode-map [menu-bar delete undelete] | ||
| 1169 | '("Undelete" . pmail-undelete-previous-message)) | ||
| 1170 | |||
| 1171 | (define-key pmail-mode-map [menu-bar delete delete] | ||
| 1172 | '("Delete" . pmail-delete-forward)) | ||
| 1173 | |||
| 1174 | (define-key pmail-mode-map [menu-bar move] | ||
| 1175 | (cons "Move" (make-sparse-keymap "Move"))) | ||
| 1176 | |||
| 1177 | (define-key pmail-mode-map [menu-bar move search-back] | ||
| 1178 | '("Search Back..." . pmail-search-backwards)) | ||
| 1179 | |||
| 1180 | (define-key pmail-mode-map [menu-bar move search] | ||
| 1181 | '("Search..." . pmail-search)) | ||
| 1182 | |||
| 1183 | (define-key pmail-mode-map [menu-bar move previous] | ||
| 1184 | '("Previous Nondeleted" . pmail-previous-undeleted-message)) | ||
| 1185 | |||
| 1186 | (define-key pmail-mode-map [menu-bar move next] | ||
| 1187 | '("Next Nondeleted" . pmail-next-undeleted-message)) | ||
| 1188 | |||
| 1189 | (define-key pmail-mode-map [menu-bar move last] | ||
| 1190 | '("Last" . pmail-last-message)) | ||
| 1191 | |||
| 1192 | (define-key pmail-mode-map [menu-bar move first] | ||
| 1193 | '("First" . pmail-first-message)) | ||
| 1194 | |||
| 1195 | (define-key pmail-mode-map [menu-bar move previous] | ||
| 1196 | '("Previous" . pmail-previous-message)) | ||
| 1197 | |||
| 1198 | (define-key pmail-mode-map [menu-bar move next] | ||
| 1199 | '("Next" . pmail-next-message)) | ||
| 1085 | 1200 | ||
| 1086 | ;; Pmail toolbar | 1201 | ;; Pmail toolbar |
| 1087 | (defvar pmail-tool-bar-map | 1202 | (defvar pmail-tool-bar-map |
| @@ -1175,12 +1290,14 @@ Instead, these commands are available: | |||
| 1175 | (let ((finding-pmail-file (not (eq major-mode 'pmail-mode)))) | 1290 | (let ((finding-pmail-file (not (eq major-mode 'pmail-mode)))) |
| 1176 | (pmail-mode-2) | 1291 | (pmail-mode-2) |
| 1177 | (when (and finding-pmail-file | 1292 | (when (and finding-pmail-file |
| 1178 | (null coding-system-for-read) | 1293 | (null coding-system-for-read) |
| 1179 | default-enable-multibyte-characters) | 1294 | default-enable-multibyte-characters) |
| 1180 | (let ((pmail-enable-multibyte t)) | 1295 | (let ((pmail-enable-multibyte t)) |
| 1181 | (pmail-require-mime-maybe) | 1296 | (pmail-require-mime-maybe) |
| 1182 | (goto-char (point-max)) | 1297 | (pmail-convert-file-maybe) |
| 1183 | (set-buffer-multibyte t))) | 1298 | (goto-char (point-max)) |
| 1299 | (set-buffer-multibyte t))) | ||
| 1300 | (pmail-set-message-counters) | ||
| 1184 | (pmail-show-message pmail-total-messages) | 1301 | (pmail-show-message pmail-total-messages) |
| 1185 | (when finding-pmail-file | 1302 | (when finding-pmail-file |
| 1186 | (when pmail-display-summary | 1303 | (when pmail-display-summary |
| @@ -1209,22 +1326,30 @@ Instead, these commands are available: | |||
| 1209 | (set-syntax-table text-mode-syntax-table) | 1326 | (set-syntax-table text-mode-syntax-table) |
| 1210 | (setq local-abbrev-table text-mode-abbrev-table)) | 1327 | (setq local-abbrev-table text-mode-abbrev-table)) |
| 1211 | 1328 | ||
| 1329 | (defun pmail-generate-viewer-buffer () | ||
| 1330 | "Return a newly created buffer suitable for viewing messages." | ||
| 1331 | (let ((suffix (file-name-nondirectory (or buffer-file-name (buffer-name))))) | ||
| 1332 | (generate-new-buffer (format " *message-viewer %s*" suffix)))) | ||
| 1333 | |||
| 1212 | ;; Set up the permanent locals associated with an Pmail file. | 1334 | ;; Set up the permanent locals associated with an Pmail file. |
| 1213 | (defun pmail-perm-variables () | 1335 | (defun pmail-perm-variables () |
| 1214 | (make-local-variable 'pmail-last-label) | 1336 | (make-local-variable 'pmail-last-label) |
| 1215 | (make-local-variable 'pmail-last-regexp) | 1337 | (make-local-variable 'pmail-last-regexp) |
| 1338 | (make-local-variable 'pmail-deleted-vector) | ||
| 1216 | (make-local-variable 'pmail-buffer) | 1339 | (make-local-variable 'pmail-buffer) |
| 1217 | (setq pmail-buffer (current-buffer)) | 1340 | (setq pmail-buffer (current-buffer)) |
| 1218 | (make-local-variable 'pmail-view-buffer) | 1341 | (make-local-variable 'pmail-view-buffer) |
| 1219 | (setq pmail-view-buffer pmail-buffer) | 1342 | (setq pmail-view-buffer (pmail-generate-viewer-buffer)) |
| 1220 | (make-local-variable 'pmail-summary-buffer) | 1343 | (make-local-variable 'pmail-summary-buffer) |
| 1344 | (make-local-variable 'pmail-summary-vector) | ||
| 1221 | (make-local-variable 'pmail-current-message) | 1345 | (make-local-variable 'pmail-current-message) |
| 1222 | (make-local-variable 'pmail-total-messages) | 1346 | (make-local-variable 'pmail-total-messages) |
| 1223 | (make-local-variable 'pmail-overlay-list) | 1347 | (make-local-variable 'pmail-overlay-list) |
| 1224 | (setq pmail-overlay-list nil) | 1348 | (setq pmail-overlay-list nil) |
| 1225 | (make-local-variable 'pmail-desc-vector) | 1349 | (make-local-variable 'pmail-message-vector) |
| 1350 | (make-local-variable 'pmail-msgref-vector) | ||
| 1226 | (make-local-variable 'pmail-inbox-list) | 1351 | (make-local-variable 'pmail-inbox-list) |
| 1227 | (setq pmail-inbox-list (pmail-get-file-inbox-list)) | 1352 | (setq pmail-inbox-list (pmail-parse-file-inboxes)) |
| 1228 | ;; Provide default set of inboxes for primary mail file ~/PMAIL. | 1353 | ;; Provide default set of inboxes for primary mail file ~/PMAIL. |
| 1229 | (and (null pmail-inbox-list) | 1354 | (and (null pmail-inbox-list) |
| 1230 | (or (equal buffer-file-name (expand-file-name pmail-file-name)) | 1355 | (or (equal buffer-file-name (expand-file-name pmail-file-name)) |
| @@ -1237,11 +1362,19 @@ Instead, these commands are available: | |||
| 1237 | (user-login-name))))))) | 1362 | (user-login-name))))))) |
| 1238 | (make-local-variable 'pmail-keywords) | 1363 | (make-local-variable 'pmail-keywords) |
| 1239 | (set (make-local-variable 'tool-bar-map) pmail-tool-bar-map) | 1364 | (set (make-local-variable 'tool-bar-map) pmail-tool-bar-map) |
| 1365 | (make-local-variable 'pmail-buffers-swapped-p) | ||
| 1240 | ;; this gets generated as needed | 1366 | ;; this gets generated as needed |
| 1241 | (setq pmail-keywords nil)) | 1367 | (setq pmail-keywords nil)) |
| 1242 | 1368 | ||
| 1243 | ;; Set up the non-permanent locals associated with Pmail mode. | 1369 | ;; Set up the non-permanent locals associated with Pmail mode. |
| 1244 | (defun pmail-variables () | 1370 | (defun pmail-variables () |
| 1371 | (make-local-variable 'save-buffer-coding-system) | ||
| 1372 | ;; If we don't already have a value for save-buffer-coding-system, | ||
| 1373 | ;; get it from buffer-file-coding-system, and clear that | ||
| 1374 | ;; because it should be determined in pmail-show-message. | ||
| 1375 | (unless save-buffer-coding-system | ||
| 1376 | (setq save-buffer-coding-system (or buffer-file-coding-system 'undecided)) | ||
| 1377 | (setq buffer-file-coding-system nil)) | ||
| 1245 | ;; Don't let a local variables list in a message cause confusion. | 1378 | ;; Don't let a local variables list in a message cause confusion. |
| 1246 | (make-local-variable 'local-enable-local-variables) | 1379 | (make-local-variable 'local-enable-local-variables) |
| 1247 | (setq local-enable-local-variables nil) | 1380 | (setq local-enable-local-variables nil) |
| @@ -1268,60 +1401,61 @@ Instead, these commands are available: | |||
| 1268 | 1401 | ||
| 1269 | ;; Handle M-x revert-buffer done in an pmail-mode buffer. | 1402 | ;; Handle M-x revert-buffer done in an pmail-mode buffer. |
| 1270 | (defun pmail-revert (arg noconfirm) | 1403 | (defun pmail-revert (arg noconfirm) |
| 1271 | (with-current-buffer pmail-buffer | 1404 | (set-buffer pmail-buffer) |
| 1272 | (let* ((revert-buffer-function (default-value 'revert-buffer-function)) | 1405 | (let* ((revert-buffer-function (default-value 'revert-buffer-function)) |
| 1273 | (pmail-enable-multibyte enable-multibyte-characters)) | 1406 | (pmail-enable-multibyte enable-multibyte-characters) |
| 1274 | ;; Call our caller again, but this time it does the default thing. | 1407 | ;; See similar code in `pmail'. |
| 1275 | (when (revert-buffer arg noconfirm) | 1408 | (coding-system-for-read (and pmail-enable-multibyte 'raw-text))) |
| 1276 | ;; If the user said "yes", and we changed something, reparse the | 1409 | ;; Call our caller again, but this time it does the default thing. |
| 1277 | ;; messages. | 1410 | (when (revert-buffer arg noconfirm) |
| 1278 | (with-current-buffer pmail-buffer | 1411 | ;; If the user said "yes", and we changed something, |
| 1279 | (pmail-mode-2) | 1412 | ;; reparse the messages. |
| 1280 | (pmail-convert-file) | 1413 | (set-buffer pmail-buffer) |
| 1281 | ;; We have read the file as raw-text, so the buffer is set to | 1414 | (pmail-mode-2) |
| 1282 | ;; unibyte. Make it multibyte if necessary. | 1415 | ;; Convert all or part to Babyl file if possible. |
| 1283 | (when (and pmail-enable-multibyte | 1416 | (pmail-convert-file-maybe) |
| 1284 | (not enable-multibyte-characters)) | 1417 | ;; We have read the file as raw-text, so the buffer is set to |
| 1285 | (set-buffer-multibyte t)) | 1418 | ;; unibyte. Make it multibyte if necessary. |
| 1286 | (pmail-initialize-messages) | 1419 | (if (and pmail-enable-multibyte |
| 1287 | (pmail-show-message pmail-total-messages) | 1420 | (not enable-multibyte-characters)) |
| 1288 | (run-hooks 'pmail-mode-hook)))))) | 1421 | (set-buffer-multibyte t)) |
| 1289 | 1422 | (goto-char (point-max)) | |
| 1290 | (defun pmail-get-file-inbox-list () | 1423 | (pmail-set-message-counters) |
| 1291 | "Return a list of inbox files for this buffer." | 1424 | (pmail-show-message pmail-total-messages) |
| 1292 | (let* ((filename (expand-file-name (buffer-file-name))) | 1425 | (run-hooks 'pmail-mode-hook)))) |
| 1293 | (inboxes (cdr (or (assoc filename pmail-inbox-alist) | 1426 | |
| 1294 | (assoc (abbreviate-file-name filename) | 1427 | ;; Return a list of files from this buffer's Mail: option. |
| 1295 | pmail-inbox-alist)))) | 1428 | ;; Does not assume that messages have been parsed. |
| 1296 | (list nil)) | 1429 | ;; Just returns nil if buffer does not look like Babyl format. |
| 1297 | (dolist (i inboxes) | 1430 | (defun pmail-parse-file-inboxes () |
| 1298 | (when (file-name-absolute-p i) | 1431 | (save-excursion |
| 1299 | (push (expand-file-name i) list))) | 1432 | (save-restriction |
| 1300 | (nreverse list))) | 1433 | (widen) |
| 1301 | 1434 | (goto-char 1) | |
| 1302 | ;;; mbox: ready | 1435 | (cond ((looking-at "BABYL OPTIONS:") |
| 1436 | (search-forward "\n\^_" nil 'move) | ||
| 1437 | (narrow-to-region 1 (point)) | ||
| 1438 | (goto-char 1) | ||
| 1439 | (when (search-forward "\nMail:" nil t) | ||
| 1440 | (narrow-to-region (point) (progn (end-of-line) (point))) | ||
| 1441 | (goto-char (point-min)) | ||
| 1442 | (mail-parse-comma-list))))))) | ||
| 1443 | |||
| 1303 | (defun pmail-expunge-and-save () | 1444 | (defun pmail-expunge-and-save () |
| 1304 | "Expunge and save PMAIL file." | 1445 | "Expunge and save PMAIL file." |
| 1305 | (interactive) | 1446 | (interactive) |
| 1306 | (pmail-expunge) | 1447 | (pmail-expunge) |
| 1448 | (set-buffer pmail-buffer) | ||
| 1307 | (save-buffer) | 1449 | (save-buffer) |
| 1308 | (pmail-display-summary-maybe)) | ||
| 1309 | |||
| 1310 | ;;; mbox: ready | ||
| 1311 | (defun pmail-display-summary-maybe () | ||
| 1312 | "If a summary buffer exists then make sure it is updated and displayed." | ||
| 1313 | (if (pmail-summary-exists) | 1450 | (if (pmail-summary-exists) |
| 1314 | (let ((current-message pmail-current-message)) | 1451 | (pmail-select-summary (set-buffer-modified-p nil)))) |
| 1315 | (pmail-select-summary | ||
| 1316 | (pmail-summary-goto-msg current-message) | ||
| 1317 | (pmail-summary-pmail-update) | ||
| 1318 | (set-buffer-modified-p nil))))) | ||
| 1319 | 1452 | ||
| 1320 | ;;; mbox: ready | ||
| 1321 | (defun pmail-quit () | 1453 | (defun pmail-quit () |
| 1322 | "Quit out of PMAIL. | 1454 | "Quit out of PMAIL. |
| 1323 | Hook `pmail-quit-hook' is run after expunging." | 1455 | Hook `pmail-quit-hook' is run after expunging." |
| 1324 | (interactive) | 1456 | (interactive) |
| 1457 | ;; Determine if the buffers need to be swapped. | ||
| 1458 | (pmail-swap-buffers-maybe) | ||
| 1325 | (pmail-expunge-and-save) | 1459 | (pmail-expunge-and-save) |
| 1326 | (when (boundp 'pmail-quit-hook) | 1460 | (when (boundp 'pmail-quit-hook) |
| 1327 | (run-hooks 'pmail-quit-hook)) | 1461 | (run-hooks 'pmail-quit-hook)) |
| @@ -1341,7 +1475,6 @@ Hook `pmail-quit-hook' is run after expunging." | |||
| 1341 | (quit-window) | 1475 | (quit-window) |
| 1342 | (replace-buffer-in-windows obuf)))) | 1476 | (replace-buffer-in-windows obuf)))) |
| 1343 | 1477 | ||
| 1344 | ;;; mbox: ready | ||
| 1345 | (defun pmail-bury () | 1478 | (defun pmail-bury () |
| 1346 | "Bury current Pmail buffer and its summary buffer." | 1479 | "Bury current Pmail buffer and its summary buffer." |
| 1347 | (interactive) | 1480 | (interactive) |
| @@ -1355,8 +1488,6 @@ Hook `pmail-quit-hook' is run after expunging." | |||
| 1355 | (bury-buffer pmail-summary-buffer))) | 1488 | (bury-buffer pmail-summary-buffer))) |
| 1356 | (quit-window))) | 1489 | (quit-window))) |
| 1357 | 1490 | ||
| 1358 | ;;;??? Fails to add descriptor for new message. | ||
| 1359 | ;;; mbox: ready | ||
| 1360 | (defun pmail-duplicate-message () | 1491 | (defun pmail-duplicate-message () |
| 1361 | "Create a duplicated copy of the current message. | 1492 | "Create a duplicated copy of the current message. |
| 1362 | The duplicate copy goes into the Pmail file just after the | 1493 | The duplicate copy goes into the Pmail file just after the |
| @@ -1365,10 +1496,11 @@ original copy." | |||
| 1365 | (widen) | 1496 | (widen) |
| 1366 | (let ((buffer-read-only nil) | 1497 | (let ((buffer-read-only nil) |
| 1367 | (number pmail-current-message) | 1498 | (number pmail-current-message) |
| 1368 | (string (buffer-substring (pmail-desc-get-start pmail-current-message) | 1499 | (string (buffer-substring (pmail-msgbeg pmail-current-message) |
| 1369 | (pmail-desc-get-end pmail-current-message)))) | 1500 | (pmail-msgend pmail-current-message)))) |
| 1370 | (goto-char (pmail-desc-get-end pmail-current-message)) | 1501 | (goto-char (pmail-msgend pmail-current-message)) |
| 1371 | (insert string) | 1502 | (insert string) |
| 1503 | (pmail-forget-messages) | ||
| 1372 | (pmail-show-message number) | 1504 | (pmail-show-message number) |
| 1373 | (message "Message duplicated"))) | 1505 | (message "Message duplicated"))) |
| 1374 | 1506 | ||
| @@ -1378,9 +1510,11 @@ original copy." | |||
| 1378 | (interactive "FRun pmail on PMAIL file: ") | 1510 | (interactive "FRun pmail on PMAIL file: ") |
| 1379 | (pmail filename)) | 1511 | (pmail filename)) |
| 1380 | 1512 | ||
| 1513 | |||
| 1381 | ;; This used to scan subdirectories recursively, but someone pointed out | 1514 | ;; This used to scan subdirectories recursively, but someone pointed out |
| 1382 | ;; that if the user wants that, person can put all the files in one dir. | 1515 | ;; that if the user wants that, person can put all the files in one dir. |
| 1383 | ;; And the recursive scan was slow. So I took it out. rms, Sep 1996. | 1516 | ;; And the recursive scan was slow. So I took it out. |
| 1517 | ;; rms, Sep 1996. | ||
| 1384 | (defun pmail-find-all-files (start) | 1518 | (defun pmail-find-all-files (start) |
| 1385 | "Return list of file in dir START that match `pmail-secondary-file-regexp'." | 1519 | "Return list of file in dir START that match `pmail-secondary-file-regexp'." |
| 1386 | (if (file-accessible-directory-p start) | 1520 | (if (file-accessible-directory-p start) |
| @@ -1437,7 +1571,7 @@ original copy." | |||
| 1437 | (cons "Output Pmail File" | 1571 | (cons "Output Pmail File" |
| 1438 | (pmail-list-to-menu "Output Pmail File" | 1572 | (pmail-list-to-menu "Output Pmail File" |
| 1439 | files | 1573 | files |
| 1440 | 'pmail-output)))) | 1574 | 'pmail-output-to-pmail-file)))) |
| 1441 | 1575 | ||
| 1442 | (define-key pmail-mode-map [menu-bar classify input-menu] | 1576 | (define-key pmail-mode-map [menu-bar classify input-menu] |
| 1443 | '("Input Pmail File" . pmail-disable-menu)) | 1577 | '("Input Pmail File" . pmail-disable-menu)) |
| @@ -1447,8 +1581,8 @@ original copy." | |||
| 1447 | 1581 | ||
| 1448 | ;;;; *** Pmail input *** | 1582 | ;;;; *** Pmail input *** |
| 1449 | 1583 | ||
| 1450 | (declare-function pmail-summary-goto-msg "pmailsum" | 1584 | (declare-function pmail-spam-filter "pmail-spam-filter" (msg)) |
| 1451 | (&optional n nowarn skip-pmail)) | 1585 | (declare-function pmail-summary-goto-msg "pmailsum" (&optional n nowarn skip-pmail)) |
| 1452 | (declare-function pmail-summary-mark-undeleted "pmailsum" (n)) | 1586 | (declare-function pmail-summary-mark-undeleted "pmailsum" (n)) |
| 1453 | (declare-function pmail-summary-mark-deleted "pmailsum" (&optional n undel)) | 1587 | (declare-function pmail-summary-mark-deleted "pmailsum" (&optional n undel)) |
| 1454 | (declare-function rfc822-addresses "rfc822" (header-text)) | 1588 | (declare-function rfc822-addresses "rfc822" (header-text)) |
| @@ -1456,141 +1590,196 @@ original copy." | |||
| 1456 | (declare-function mail-sendmail-delimit-header "sendmail" ()) | 1590 | (declare-function mail-sendmail-delimit-header "sendmail" ()) |
| 1457 | (declare-function mail-header-end "sendmail" ()) | 1591 | (declare-function mail-header-end "sendmail" ()) |
| 1458 | 1592 | ||
| 1459 | (defun pmail-get-inbox-files () | 1593 | ;; RLK feature not added in this version: |
| 1460 | "Return all files from `pmail-inbox-list' without name conflicts. | 1594 | ;; argument specifies inbox file or files in various ways. |
| 1461 | A conflict happens when two inbox file names have the same name | ||
| 1462 | according to `file-name-nondirectory'." | ||
| 1463 | (let (files last-names) | ||
| 1464 | (catch 'conflict | ||
| 1465 | (dolist (file pmail-inbox-list) | ||
| 1466 | (if (member (file-name-nondirectory file) last-names) | ||
| 1467 | (throw 'conflict t) | ||
| 1468 | (push file files)) | ||
| 1469 | (push (file-name-nondirectory file) last-names))) | ||
| 1470 | (nreverse files))) | ||
| 1471 | |||
| 1472 | (defun pmail-delete-inbox-files (files) | ||
| 1473 | "Delete all files given in FILES. | ||
| 1474 | If delete fails, truncate them to zero length." | ||
| 1475 | (dolist (file files) | ||
| 1476 | (condition-case nil | ||
| 1477 | ;; First, try deleting. | ||
| 1478 | (condition-case nil | ||
| 1479 | (delete-file file) | ||
| 1480 | ;; If we can't delete it, truncate it. | ||
| 1481 | (file-error (write-region (point) (point) file))) | ||
| 1482 | (file-error nil)))) | ||
| 1483 | |||
| 1484 | (autoload 'rmail-spam-filter "rmail-spam-filter") | ||
| 1485 | 1595 | ||
| 1486 | (defun pmail-get-new-mail (&optional file-name) | 1596 | (defun pmail-get-new-mail (&optional file-name) |
| 1487 | "Move any new mail from this mail file's inbox files. | 1597 | "Move any new mail from this PMAIL file's inbox files. |
| 1488 | The inbox files for the primary mail file are determined using | 1598 | The inbox files can be specified with the file's Mail: option. The |
| 1489 | various means when setting up the buffer. The list of inbox | 1599 | variable `pmail-primary-inbox-list' specifies the inboxes for your |
| 1490 | files are stored in `pmail-inbox-list'. | 1600 | primary PMAIL file if it has no Mail: option. By default, this is |
| 1491 | 1601 | your /usr/spool/mail/$USER. | |
| 1492 | The most important variable that determines the value of this | 1602 | |
| 1493 | list is `pmail-inbox-alist' which lists the inbox files for any | 1603 | You can also specify the file to get new mail from. In this case, the |
| 1494 | mail files you might be using. | 1604 | file of new mail is not changed or deleted. Noninteractively, you can |
| 1495 | 1605 | pass the inbox file name as an argument. Interactively, a prefix | |
| 1496 | If the above yields no inbox files, and if this is the primary | 1606 | argument causes us to read a file name and use that file as the inbox. |
| 1497 | mail file as determined by `pmail-file-name', the inbox lists | ||
| 1498 | otherwise defaults to `pmail-primary-inbox-list' if set, or the | ||
| 1499 | environment variable MAIL if set, or the user's mail file in | ||
| 1500 | `rmail-spool-directory'. | ||
| 1501 | |||
| 1502 | This is why, by default, no mail file has inbox files, except for | ||
| 1503 | the primary mail file ~/PMAIL, which gets its new mail from the | ||
| 1504 | mail spool. | ||
| 1505 | |||
| 1506 | You can also specify the file to get new mail from interactively. | ||
| 1507 | A prefix argument will read a file name and use that file as the | ||
| 1508 | inbox. Noninteractively, you can pass the inbox file name as an | ||
| 1509 | argument. | ||
| 1510 | 1607 | ||
| 1511 | If the variable `pmail-preserve-inbox' is non-nil, new mail will | 1608 | If the variable `pmail-preserve-inbox' is non-nil, new mail will |
| 1512 | always be left in inbox files rather than deleted. | 1609 | always be left in inbox files rather than deleted. |
| 1513 | 1610 | ||
| 1514 | This function runs `pmail-get-new-mail-hook' before saving the | 1611 | This function runs `pmail-get-new-mail-hook' before saving the updated file. |
| 1515 | updated file. It returns t if it got any new messages." | 1612 | It returns t if it got any new messages." |
| 1516 | (interactive | 1613 | (interactive |
| 1517 | (list (when current-prefix-arg | 1614 | (list (if current-prefix-arg |
| 1518 | (read-file-name "Get new mail from file: ")))) | 1615 | (read-file-name "Get new mail from file: ")))) |
| 1519 | (run-hooks 'pmail-before-get-new-mail-hook) | 1616 | (run-hooks 'pmail-before-get-new-mail-hook) |
| 1520 | ;; If the disk file has been changed from under us, revert to it | 1617 | ;; If the disk file has been changed from under us, |
| 1521 | ;; before we get new mail. | 1618 | ;; revert to it before we get new mail. |
| 1522 | (unless (verify-visited-file-modtime (current-buffer)) | 1619 | (or (verify-visited-file-modtime (current-buffer)) |
| 1523 | (find-file (buffer-file-name))) | 1620 | (find-file (buffer-file-name))) |
| 1524 | (with-current-buffer pmail-buffer | 1621 | (set-buffer pmail-buffer) |
| 1525 | (widen) | 1622 | (pmail-maybe-set-message-counters) |
| 1526 | ;; Get rid of all undo records for this buffer. | 1623 | (widen) |
| 1527 | (unless (eq buffer-undo-list t) | 1624 | ;; Get rid of all undo records for this buffer. |
| 1625 | (or (eq buffer-undo-list t) | ||
| 1528 | (setq buffer-undo-list nil)) | 1626 | (setq buffer-undo-list nil)) |
| 1529 | (let ((pmail-enable-multibyte (default-value 'enable-multibyte-characters)) | 1627 | (let ((all-files (if file-name (list file-name) |
| 1530 | ;; If buffer has not changed yet, and has not been saved yet, | 1628 | pmail-inbox-list)) |
| 1531 | ;; don't replace the old backup file now. | 1629 | (pmail-enable-multibyte (default-value 'enable-multibyte-characters)) |
| 1532 | (make-backup-files (and make-backup-files (buffer-modified-p))) | 1630 | found) |
| 1533 | current-message found) | 1631 | (unwind-protect |
| 1534 | (condition-case nil | 1632 | (progn |
| 1535 | (let ((buffer-read-only nil) | 1633 | (while all-files |
| 1536 | (buffer-undo-list t) | 1634 | (let ((opoint (point)) |
| 1537 | (delete-files nil) | 1635 | (new-messages 0) |
| 1538 | (new-messages 0) | 1636 | (rsf-number-of-spam 0) |
| 1539 | (rsf-number-of-spam 0)) | 1637 | (delete-files ()) |
| 1540 | (save-excursion | 1638 | ;; If buffer has not changed yet, and has not been saved yet, |
| 1541 | (save-restriction | 1639 | ;; don't replace the old backup file now. |
| 1542 | (goto-char (point-max)) | 1640 | (make-backup-files (and make-backup-files (buffer-modified-p))) |
| 1543 | (narrow-to-region (point) (point)) | 1641 | (buffer-read-only nil) |
| 1544 | ;; Read in the contents of the inbox files, renaming | 1642 | ;; Don't make undo records for what we do in getting mail. |
| 1545 | ;; them as necessary, and adding to the list of files to | 1643 | (buffer-undo-list t) |
| 1546 | ;; delete eventually. | 1644 | success |
| 1547 | (if file-name | 1645 | ;; Files to insert this time around. |
| 1548 | (pmail-insert-inbox-text (list file-name) nil) | 1646 | files |
| 1549 | (setq delete-files (pmail-insert-inbox-text | 1647 | ;; Last names of those files. |
| 1550 | (pmail-get-inbox-files) t))) | 1648 | file-last-names) |
| 1551 | ;; Process newly found messages and save them into the | 1649 | ;; Pull files off all-files onto files |
| 1552 | ;; PMAIL file. | 1650 | ;; as long as there is no name conflict. |
| 1553 | (unless (equal (point-min) (point-max)) | 1651 | ;; A conflict happens when two inbox file names |
| 1554 | (setq new-messages (pmail-convert-mbox-format)) | 1652 | ;; have the same last component. |
| 1555 | (unless (zerop new-messages) | 1653 | (while (and all-files |
| 1556 | (pmail-process-new-messages) | 1654 | (not (member (file-name-nondirectory (car all-files)) |
| 1557 | (setq pmail-current-message (1+ pmail-total-messages) | 1655 | file-last-names))) |
| 1558 | pmail-total-messages (pmail-desc-get-count))) | 1656 | (setq files (cons (car all-files) files) |
| 1559 | (save-buffer)) | 1657 | file-last-names |
| 1560 | ;; Delete the old files, now that the PMAIL file is | 1658 | (cons (file-name-nondirectory (car all-files)) files)) |
| 1561 | ;; saved. | 1659 | (setq all-files (cdr all-files))) |
| 1562 | (when delete-files | 1660 | ;; Put them back in their original order. |
| 1563 | (pmail-delete-inbox-files delete-files)))) | 1661 | (setq files (nreverse files)) |
| 1564 | 1662 | ||
| 1565 | (if (zerop new-messages) | 1663 | (goto-char (point-max)) |
| 1566 | (when (or file-name pmail-inbox-list) | 1664 | (skip-chars-backward " \t\n") ; just in case of brain damage |
| 1567 | (pmail-show-message) | 1665 | (delete-region (point) (point-max)) ; caused by require-final-newline |
| 1568 | (message "(No new mail has arrived)")) | 1666 | (save-excursion |
| 1569 | 1667 | (save-restriction | |
| 1570 | ;; Process the new messages for spam using the integrated | 1668 | (narrow-to-region (point) (point)) |
| 1571 | ;; spam filter. The spam filter can mark messages for | 1669 | ;; Read in the contents of the inbox files, |
| 1572 | ;; deletion and can output a message. | 1670 | ;; renaming them as necessary, |
| 1573 | (setq current-message (pmail-first-unseen-message)) | 1671 | ;; and adding to the list of files to delete eventually. |
| 1574 | (when pmail-use-spam-filter | 1672 | (if file-name |
| 1575 | (while (<= current-message pmail-total-messages) | 1673 | (pmail-insert-inbox-text files nil) |
| 1576 | (rmail-spam-filter current-message) | 1674 | (setq delete-files (pmail-insert-inbox-text files t))) |
| 1577 | (setq current-message (1+ current-message)))) | 1675 | ;; Scan the new text and convert each message to mbox format. |
| 1578 | ;; Make the first unseen message the current message and | 1676 | (goto-char (point-min)) |
| 1579 | ;; update the summary buffer, if one exists. | 1677 | (unwind-protect |
| 1580 | (setq current-message (pmail-first-unseen-message)) | 1678 | (save-excursion |
| 1581 | (if (pmail-summary-exists) | 1679 | (setq new-messages (pmail-add-babyl-headers) |
| 1582 | (with-current-buffer pmail-summary-buffer | 1680 | success t)) |
| 1583 | (pmail-update-summary) | 1681 | ;; Try to delete the garbage just inserted. |
| 1584 | (pmail-summary-goto-msg current-message)) | 1682 | (or success (delete-region (point-min) (point-max))) |
| 1585 | (pmail-show-message current-message)) | 1683 | ;; If we could not convert the file's inboxes, |
| 1586 | ;; Run the after get new mail hook. | 1684 | ;; rename the files we tried to read |
| 1587 | (run-hooks 'pmail-after-get-new-mail-hook) | 1685 | ;; so we won't over and over again. |
| 1588 | (message "%d new message%s read" | 1686 | (if (and (not file-name) (not success)) |
| 1589 | new-messages (if (= 1 new-messages) "" "s")) | 1687 | (let ((delfiles delete-files) |
| 1590 | (setq found t)) | 1688 | (count 0)) |
| 1591 | found) | 1689 | (while delfiles |
| 1592 | ;; Don't leave the buffer screwed up if we get a disk-full error. | 1690 | (while (file-exists-p (format "PMAILOSE.%d" count)) |
| 1593 | (file-error (or found (pmail-show-message))))))) | 1691 | (setq count (1+ count))) |
| 1692 | (rename-file (car delfiles) | ||
| 1693 | (format "PMAILOSE.%d" count)) | ||
| 1694 | (setq delfiles (cdr delfiles)))))) | ||
| 1695 | (or (zerop new-messages) | ||
| 1696 | (let (success) | ||
| 1697 | (goto-char (point-min)) | ||
| 1698 | (pmail-count-new-messages) | ||
| 1699 | (run-hooks 'pmail-get-new-mail-hook) | ||
| 1700 | (save-buffer))) | ||
| 1701 | ;; Delete the old files, now that babyl file is saved. | ||
| 1702 | (while delete-files | ||
| 1703 | (condition-case () | ||
| 1704 | ;; First, try deleting. | ||
| 1705 | (condition-case () | ||
| 1706 | (delete-file (car delete-files)) | ||
| 1707 | (file-error | ||
| 1708 | ;; If we can't delete it, truncate it. | ||
| 1709 | (write-region (point) (point) (car delete-files)))) | ||
| 1710 | (file-error nil)) | ||
| 1711 | (setq delete-files (cdr delete-files))))) | ||
| 1712 | (if (= new-messages 0) | ||
| 1713 | (progn (goto-char opoint) | ||
| 1714 | (if (or file-name pmail-inbox-list) | ||
| 1715 | (message "(No new mail has arrived)"))) | ||
| 1716 | ;; check new messages to see if any of them is spam: | ||
| 1717 | (if (and (featurep 'pmail-spam-filter) | ||
| 1718 | pmail-use-spam-filter) | ||
| 1719 | (let* | ||
| 1720 | ((old-messages (- pmail-total-messages new-messages)) | ||
| 1721 | (rsf-scanned-message-number (1+ old-messages)) | ||
| 1722 | ;; save deletion flags of old messages: vector starts | ||
| 1723 | ;; at zero (is one longer that no of messages), | ||
| 1724 | ;; therefore take 1+ old-messages | ||
| 1725 | (save-deleted | ||
| 1726 | (substring pmail-deleted-vector 0 (1+ | ||
| 1727 | old-messages)))) | ||
| 1728 | ;; set all messages to undeleted | ||
| 1729 | (setq pmail-deleted-vector | ||
| 1730 | (make-string (1+ pmail-total-messages) ?\ )) | ||
| 1731 | (while (<= rsf-scanned-message-number | ||
| 1732 | pmail-total-messages) | ||
| 1733 | (progn | ||
| 1734 | (if (not (pmail-spam-filter rsf-scanned-message-number)) | ||
| 1735 | (progn (setq rsf-number-of-spam (1+ rsf-number-of-spam))) | ||
| 1736 | ) | ||
| 1737 | (setq rsf-scanned-message-number (1+ rsf-scanned-message-number)) | ||
| 1738 | )) | ||
| 1739 | (if (> rsf-number-of-spam 0) | ||
| 1740 | (progn | ||
| 1741 | (when (pmail-expunge-confirmed) | ||
| 1742 | (pmail-only-expunge t)) | ||
| 1743 | )) | ||
| 1744 | (setq pmail-deleted-vector | ||
| 1745 | (concat | ||
| 1746 | save-deleted | ||
| 1747 | (make-string (- pmail-total-messages old-messages) | ||
| 1748 | ?\ ))) | ||
| 1749 | )) | ||
| 1750 | (if (pmail-summary-exists) | ||
| 1751 | (pmail-select-summary | ||
| 1752 | (pmail-update-summary))) | ||
| 1753 | (message "%d new message%s read%s" | ||
| 1754 | new-messages (if (= 1 new-messages) "" "s") | ||
| 1755 | ;; print out a message on number of spam messages found: | ||
| 1756 | (if (and (featurep 'pmail-spam-filter) | ||
| 1757 | pmail-use-spam-filter | ||
| 1758 | (> rsf-number-of-spam 0)) | ||
| 1759 | (cond ((= 1 new-messages) | ||
| 1760 | ", and appears to be spam") | ||
| 1761 | ((= rsf-number-of-spam new-messages) | ||
| 1762 | ", and all appear to be spam") | ||
| 1763 | ((> rsf-number-of-spam 1) | ||
| 1764 | (format ", and %d appear to be spam" | ||
| 1765 | rsf-number-of-spam)) | ||
| 1766 | (t | ||
| 1767 | ", and 1 appears to be spam")) | ||
| 1768 | "")) | ||
| 1769 | (when (and (featurep 'pmail-spam-filter) | ||
| 1770 | pmail-use-spam-filter | ||
| 1771 | (> rsf-number-of-spam 0)) | ||
| 1772 | (if rsf-beep (beep t)) | ||
| 1773 | (sleep-for rsf-sleep-after-message)) | ||
| 1774 | |||
| 1775 | ;; Move to the first new message | ||
| 1776 | ;; unless we have other unseen messages before it. | ||
| 1777 | (pmail-show-message (pmail-first-unseen-message)) | ||
| 1778 | (run-hooks 'pmail-after-get-new-mail-hook) | ||
| 1779 | (setq found t)))) | ||
| 1780 | found) | ||
| 1781 | ;; Don't leave the buffer screwed up if we get a disk-full error. | ||
| 1782 | (or found (pmail-show-message))))) | ||
| 1594 | 1783 | ||
| 1595 | (defun pmail-parse-url (file) | 1784 | (defun pmail-parse-url (file) |
| 1596 | "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD) | 1785 | "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD) |
| @@ -1613,8 +1802,11 @@ is non-nil if the user has supplied the password interactively. | |||
| 1613 | (when pmail-remote-password-required | 1802 | (when pmail-remote-password-required |
| 1614 | (setq got-password (not (pmail-have-password))) | 1803 | (setq got-password (not (pmail-have-password))) |
| 1615 | (setq supplied-password (pmail-get-remote-password | 1804 | (setq supplied-password (pmail-get-remote-password |
| 1616 | (string-equal proto "imap"))))) | 1805 | (string-equal proto "imap")))) |
| 1617 | 1806 | ;; The password is embedded. Strip it out since movemail | |
| 1807 | ;; does not really like it, in spite of the movemail spec. | ||
| 1808 | (setq file (concat proto "://" user "@" host))) | ||
| 1809 | |||
| 1618 | (if (pmail-movemail-variant-p 'emacs) | 1810 | (if (pmail-movemail-variant-p 'emacs) |
| 1619 | (if (string-equal proto "pop") | 1811 | (if (string-equal proto "pop") |
| 1620 | (list (concat "po:" user ":" host) | 1812 | (list (concat "po:" user ":" host) |
| @@ -1622,7 +1814,7 @@ is non-nil if the user has supplied the password interactively. | |||
| 1622 | (or pass supplied-password) | 1814 | (or pass supplied-password) |
| 1623 | got-password) | 1815 | got-password) |
| 1624 | (error "Emacs movemail does not support %s protocol" proto)) | 1816 | (error "Emacs movemail does not support %s protocol" proto)) |
| 1625 | (list (concat proto "://" user "@" host) | 1817 | (list file |
| 1626 | (or (string-equal proto "pop") (string-equal proto "imap")) | 1818 | (or (string-equal proto "pop") (string-equal proto "imap")) |
| 1627 | (or supplied-password pass) | 1819 | (or supplied-password pass) |
| 1628 | got-password)))) | 1820 | got-password)))) |
| @@ -1680,13 +1872,12 @@ is non-nil if the user has supplied the password interactively. | |||
| 1680 | (expand-file-name buffer-file-name)))) | 1872 | (expand-file-name buffer-file-name)))) |
| 1681 | ;; Always use movemail to rename the file, | 1873 | ;; Always use movemail to rename the file, |
| 1682 | ;; since there can be mailboxes in various directories. | 1874 | ;; since there can be mailboxes in various directories. |
| 1683 | (if (not popmail) | 1875 | (when (not popmail) |
| 1684 | (progn | 1876 | ;; On some systems, /usr/spool/mail/foo is a directory |
| 1685 | ;; On some systems, /usr/spool/mail/foo is a directory | 1877 | ;; and the actual inbox is /usr/spool/mail/foo/foo. |
| 1686 | ;; and the actual inbox is /usr/spool/mail/foo/foo. | 1878 | (if (file-directory-p file) |
| 1687 | (if (file-directory-p file) | 1879 | (setq file (expand-file-name (user-login-name) |
| 1688 | (setq file (expand-file-name (user-login-name) | 1880 | file)))) |
| 1689 | file))))) | ||
| 1690 | (cond (popmail | 1881 | (cond (popmail |
| 1691 | (message "Getting mail from the remote server ...")) | 1882 | (message "Getting mail from the remote server ...")) |
| 1692 | ((and (file-exists-p tofile) | 1883 | ((and (file-exists-p tofile) |
| @@ -1761,6 +1952,18 @@ is non-nil if the user has supplied the password interactively. | |||
| 1761 | size) | 1952 | size) |
| 1762 | (goto-char (point-max)) | 1953 | (goto-char (point-max)) |
| 1763 | (setq size (nth 1 (insert-file-contents tofile))) | 1954 | (setq size (nth 1 (insert-file-contents tofile))) |
| 1955 | ;; Determine if a pair of newline message separators need | ||
| 1956 | ;; to be added to the new collection of messages. This is | ||
| 1957 | ;; the case for all new message collections added to a | ||
| 1958 | ;; non-empty mail file. | ||
| 1959 | (unless (zerop size) | ||
| 1960 | (save-restriction | ||
| 1961 | (let ((start (point-min))) | ||
| 1962 | (widen) | ||
| 1963 | (unless (eq start (point-min)) | ||
| 1964 | (goto-char start) | ||
| 1965 | (insert "\n\n") | ||
| 1966 | (setq size (+ 2 size)))))) | ||
| 1764 | (goto-char (point-max)) | 1967 | (goto-char (point-max)) |
| 1765 | (or (= (preceding-char) ?\n) | 1968 | (or (= (preceding-char) ?\n) |
| 1766 | (zerop size) | 1969 | (zerop size) |
| @@ -1770,110 +1973,482 @@ is non-nil if the user has supplied the password interactively. | |||
| 1770 | (message "") | 1973 | (message "") |
| 1771 | (setq files (cdr files))) | 1974 | (setq files (cdr files))) |
| 1772 | delete-files)) | 1975 | delete-files)) |
| 1773 | 1976 | ||
| 1774 | ;;;; *** Pmail message decoding *** | 1977 | ;; Decode the region specified by FROM and TO by CODING. |
| 1775 | 1978 | ;; If CODING is nil or an invalid coding system, decode by `undecided'. | |
| 1776 | ;; these two are unused, and possibly harmul. | 1979 | (defun pmail-decode-region (from to coding) |
| 1777 | 1980 | (if (or (not coding) (not (coding-system-p coding))) | |
| 1778 | ;; (defun pmail-decode-region (from to coding) | 1981 | (setq coding 'undecided)) |
| 1779 | ;; "Decode the region specified by FROM and TO by CODING. | 1982 | ;; Use -dos decoding, to remove ^M characters left from base64 or |
| 1780 | ;; If CODING is nil or an invalid coding system, decode by `undecided'." | 1983 | ;; rogue qp-encoded text. |
| 1781 | ;; (unless (and coding (coding-system-p coding)) | 1984 | (decode-coding-region from to |
| 1782 | ;; (setq coding 'undecided)) | 1985 | (coding-system-change-eol-conversion coding 1)) |
| 1783 | ;; ;; Use -dos decoding, to remove ^M characters left from base64 or | 1986 | ;; Don't reveal the fact we used -dos decoding, as users generally |
| 1784 | ;; ;; rogue qp-encoded text. | 1987 | ;; will not expect the PMAIL buffer to use DOS EOL format. |
| 1785 | ;; (decode-coding-region from to | 1988 | (setq buffer-file-coding-system |
| 1786 | ;; (coding-system-change-eol-conversion | 1989 | (setq last-coding-system-used |
| 1787 | ;; coding 'dos)) | 1990 | (coding-system-change-eol-conversion coding 0)))) |
| 1788 | ;; ;; Don't reveal the fact we used -dos decoding, as users generally | 1991 | |
| 1789 | ;; ;; will not expect the PMAIL buffer to use DOS EOL format. | 1992 | (defun pmail-add-babyl-headers () |
| 1790 | ;; (setq buffer-file-coding-system | 1993 | "Validate the RFC2822 format for the new messages. Point, at |
| 1791 | ;; (setq last-coding-system-used | 1994 | entry should be looking at the first new message. An error will |
| 1792 | ;; (coding-system-change-eol-conversion | 1995 | be thrown if the new messages are not RCC2822 compliant. Lastly, |
| 1793 | ;; coding 'unix)))) | 1996 | unless one already exists, add an Rmail attribute header to the |
| 1794 | 1997 | new messages in the region " | |
| 1795 | ;; (defun pmail-decode-by-content-type (from to) | 1998 | (let ((count 0) |
| 1796 | ;; "Decode message between FROM and TO according to Content-Type." | 1999 | (start (point)) |
| 1797 | ;; (when (and (not pmail-enable-mime) pmail-enable-multibyte) | 2000 | limit) |
| 1798 | ;; (let ((coding-system-used nil) | 2001 | ;; Detect an empty inbox file. |
| 1799 | ;; (case-fold-search t)) | 2002 | (unless (= start (point-max)) |
| 1800 | ;; (save-restriction | 2003 | ;; Scan the new messages to establish a count and to insure that |
| 1801 | ;; (narrow-to-region from to) | 2004 | ;; an attribute header is present. |
| 1802 | ;; (when (and (not pmail-enable-mime) pmail-enable-multibyte) | 2005 | (while (looking-at "From ") |
| 1803 | ;; (let ((coding | 2006 | ;; Determine if a new attribute header needs to be added to |
| 1804 | ;; (when (save-excursion | 2007 | ;; the message. |
| 1805 | ;; (goto-char (pmail-header-get-limit)) | 2008 | (if (search-forward "\n\n" nil t) |
| 1806 | ;; (re-search-backward | 2009 | (progn |
| 1807 | ;; pmail-mime-charset-pattern | 2010 | (setq count (1+ count)) |
| 1808 | ;; (point-min) t)) | 2011 | (forward-char -1) |
| 1809 | ;; (intern (downcase (match-string 1)))))) | 2012 | (narrow-to-region start (point)) |
| 1810 | ;; (setq coding-system-used (pmail-decode-region | 2013 | (unless (mail-fetch-field pmail-attribute-header) |
| 1811 | ;; (point-min) (point-max) | 2014 | (insert pmail-attribute-header ": ------U\n")) |
| 1812 | ;; coding))))) | 2015 | (widen)) |
| 1813 | ;; (setq last-coding-system-used coding-system-used)))) | 2016 | (error "Invalid mbox format detected in inbox file")) |
| 2017 | ;; Move to the next message. | ||
| 2018 | (if (search-forward "\n\nFrom " nil 'move) | ||
| 2019 | (forward-char -5)) | ||
| 2020 | (setq start (point)))) | ||
| 2021 | count)) | ||
| 2022 | |||
| 2023 | ;; the pmail-break-forwarded-messages feature is not implemented | ||
| 2024 | (defun pmail-convert-to-babyl-format () | ||
| 2025 | (let ((count 0) start | ||
| 2026 | (case-fold-search nil) | ||
| 2027 | (buffer-undo-list t) | ||
| 2028 | (invalid-input-resync | ||
| 2029 | (function (lambda () | ||
| 2030 | (message "Invalid Babyl format in inbox!") | ||
| 2031 | (sit-for 3) | ||
| 2032 | ;; Try to get back in sync with a real message. | ||
| 2033 | (if (re-search-forward | ||
| 2034 | (concat pmail-mmdf-delim1 "\\|^From") nil t) | ||
| 2035 | (beginning-of-line) | ||
| 2036 | (goto-char (point-max))))))) | ||
| 2037 | (goto-char (point-min)) | ||
| 2038 | (save-restriction | ||
| 2039 | (while (not (eobp)) | ||
| 2040 | (setq start (point)) | ||
| 2041 | (cond ((looking-at "BABYL OPTIONS:") ;Babyl header | ||
| 2042 | (if (search-forward "\n\^_" nil t) | ||
| 2043 | ;; If we find the proper terminator, delete through there. | ||
| 2044 | (delete-region (point-min) (point)) | ||
| 2045 | (funcall invalid-input-resync) | ||
| 2046 | (delete-region (point-min) (point)))) | ||
| 2047 | ;; Babyl format message | ||
| 2048 | ((looking-at "\^L") | ||
| 2049 | (or (search-forward "\n\^_" nil t) | ||
| 2050 | (funcall invalid-input-resync)) | ||
| 2051 | (setq count (1+ count)) | ||
| 2052 | ;; Make sure there is no extra white space after the ^_ | ||
| 2053 | ;; at the end of the message. | ||
| 2054 | ;; Narrowing will make sure that whatever follows the junk | ||
| 2055 | ;; will be treated properly. | ||
| 2056 | (delete-region (point) | ||
| 2057 | (save-excursion | ||
| 2058 | (skip-chars-forward " \t\n") | ||
| 2059 | (point))) | ||
| 2060 | ;; The following let* form was wrapped in a `save-excursion' | ||
| 2061 | ;; which in one case caused infinite looping, see: | ||
| 2062 | ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00968.html | ||
| 2063 | ;; Removing that form leaves `point' at the end of the | ||
| 2064 | ;; region decoded by `pmail-decode-region' which should | ||
| 2065 | ;; be correct. | ||
| 2066 | (let* ((header-end | ||
| 2067 | (progn | ||
| 2068 | (save-excursion | ||
| 2069 | (goto-char start) | ||
| 2070 | (forward-line 1) | ||
| 2071 | (if (looking-at "0") | ||
| 2072 | (forward-line 1) | ||
| 2073 | (forward-line 2)) | ||
| 2074 | (save-restriction | ||
| 2075 | (narrow-to-region (point) (point-max)) | ||
| 2076 | (rfc822-goto-eoh) | ||
| 2077 | (point))))) | ||
| 2078 | (case-fold-search t) | ||
| 2079 | (quoted-printable-header-field-end | ||
| 2080 | (save-excursion | ||
| 2081 | (goto-char start) | ||
| 2082 | (re-search-forward | ||
| 2083 | "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" | ||
| 2084 | header-end t))) | ||
| 2085 | (base64-header-field-end | ||
| 2086 | (save-excursion | ||
| 2087 | (goto-char start) | ||
| 2088 | ;; Don't try to decode non-text data. | ||
| 2089 | (and (re-search-forward | ||
| 2090 | "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" | ||
| 2091 | header-end t) | ||
| 2092 | (goto-char start) | ||
| 2093 | (re-search-forward | ||
| 2094 | "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" | ||
| 2095 | header-end t))))) | ||
| 2096 | (if quoted-printable-header-field-end | ||
| 2097 | (save-excursion | ||
| 2098 | (unless | ||
| 2099 | (mail-unquote-printable-region header-end (point) nil t t) | ||
| 2100 | (message "Malformed MIME quoted-printable message")) | ||
| 2101 | ;; Change "quoted-printable" to "8bit", | ||
| 2102 | ;; to reflect the decoding we just did. | ||
| 2103 | (goto-char quoted-printable-header-field-end) | ||
| 2104 | (delete-region (point) (search-backward ":")) | ||
| 2105 | (insert ": 8bit"))) | ||
| 2106 | (if base64-header-field-end | ||
| 2107 | (save-excursion | ||
| 2108 | (when | ||
| 2109 | (condition-case nil | ||
| 2110 | (progn | ||
| 2111 | (base64-decode-region (1+ header-end) | ||
| 2112 | (- (point) 2)) | ||
| 2113 | t) | ||
| 2114 | (error nil)) | ||
| 2115 | ;; Change "base64" to "8bit", to reflect the | ||
| 2116 | ;; decoding we just did. | ||
| 2117 | (goto-char base64-header-field-end) | ||
| 2118 | (delete-region (point) (search-backward ":")) | ||
| 2119 | (insert ": 8bit")))) | ||
| 2120 | (setq last-coding-system-used nil) | ||
| 2121 | (or pmail-enable-mime | ||
| 2122 | (not pmail-enable-multibyte) | ||
| 2123 | (let ((mime-charset | ||
| 2124 | (if (and pmail-decode-mime-charset | ||
| 2125 | (save-excursion | ||
| 2126 | (goto-char start) | ||
| 2127 | (search-forward "\n\n" nil t) | ||
| 2128 | (let ((case-fold-search t)) | ||
| 2129 | (re-search-backward | ||
| 2130 | pmail-mime-charset-pattern | ||
| 2131 | start t)))) | ||
| 2132 | (intern (downcase (match-string 1)))))) | ||
| 2133 | (pmail-decode-region start (point) mime-charset)))) | ||
| 2134 | ;; Add an X-Coding-System: header if we don't have one. | ||
| 2135 | (save-excursion | ||
| 2136 | (goto-char start) | ||
| 2137 | (forward-line 1) | ||
| 2138 | (if (looking-at "0") | ||
| 2139 | (forward-line 1) | ||
| 2140 | (forward-line 2)) | ||
| 2141 | (or (save-restriction | ||
| 2142 | (narrow-to-region (point) (point-max)) | ||
| 2143 | (rfc822-goto-eoh) | ||
| 2144 | (goto-char (point-min)) | ||
| 2145 | (re-search-forward "^X-Coding-System:" nil t)) | ||
| 2146 | (insert "X-Coding-System: " | ||
| 2147 | (symbol-name last-coding-system-used) | ||
| 2148 | "\n"))) | ||
| 2149 | (narrow-to-region (point) (point-max)) | ||
| 2150 | (and (= 0 (% count 10)) | ||
| 2151 | (message "Converting to Babyl format...%d" count))) | ||
| 2152 | ;;*** MMDF format | ||
| 2153 | ((let ((case-fold-search t)) | ||
| 2154 | (looking-at pmail-mmdf-delim1)) | ||
| 2155 | (let ((case-fold-search t)) | ||
| 2156 | (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n") | ||
| 2157 | (re-search-forward pmail-mmdf-delim2 nil t) | ||
| 2158 | (replace-match "\^_")) | ||
| 2159 | (save-excursion | ||
| 2160 | (save-restriction | ||
| 2161 | (narrow-to-region start (1- (point))) | ||
| 2162 | (goto-char (point-min)) | ||
| 2163 | (while (search-forward "\n\^_" nil t) ; single char "\^_" | ||
| 2164 | (replace-match "\n^_")))) ; 2 chars: "^" and "_" | ||
| 2165 | (setq last-coding-system-used nil) | ||
| 2166 | (or pmail-enable-mime | ||
| 2167 | (not pmail-enable-multibyte) | ||
| 2168 | (decode-coding-region start (point) 'undecided)) | ||
| 2169 | (save-excursion | ||
| 2170 | (goto-char start) | ||
| 2171 | (forward-line 3) | ||
| 2172 | (insert "X-Coding-System: " | ||
| 2173 | (symbol-name last-coding-system-used) | ||
| 2174 | "\n")) | ||
| 2175 | (narrow-to-region (point) (point-max)) | ||
| 2176 | (setq count (1+ count)) | ||
| 2177 | (and (= 0 (% count 10)) | ||
| 2178 | (message "Converting to Babyl format...%d" count))) | ||
| 2179 | ;;*** Mail format | ||
| 2180 | ((looking-at "^From ") | ||
| 2181 | (insert "\^L\n0, unseen,,\n*** EOOH ***\n") | ||
| 2182 | (pmail-nuke-pinhead-header) | ||
| 2183 | ;; If this message has a Content-Length field, | ||
| 2184 | ;; skip to the end of the contents. | ||
| 2185 | (let* ((header-end (save-excursion | ||
| 2186 | (and (re-search-forward "\n\n" nil t) | ||
| 2187 | (1- (point))))) | ||
| 2188 | (case-fold-search t) | ||
| 2189 | (quoted-printable-header-field-end | ||
| 2190 | (save-excursion | ||
| 2191 | (re-search-forward | ||
| 2192 | "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" | ||
| 2193 | header-end t))) | ||
| 2194 | (base64-header-field-end | ||
| 2195 | (and | ||
| 2196 | ;; Don't decode non-text data. | ||
| 2197 | (save-excursion | ||
| 2198 | (re-search-forward | ||
| 2199 | "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" | ||
| 2200 | header-end t)) | ||
| 2201 | (save-excursion | ||
| 2202 | (re-search-forward | ||
| 2203 | "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" | ||
| 2204 | header-end t)))) | ||
| 2205 | (size | ||
| 2206 | ;; Get the numeric value from the Content-Length field. | ||
| 2207 | (save-excursion | ||
| 2208 | ;; Back up to end of prev line, | ||
| 2209 | ;; in case the Content-Length field comes first. | ||
| 2210 | (forward-char -1) | ||
| 2211 | (and (search-forward "\ncontent-length: " | ||
| 2212 | header-end t) | ||
| 2213 | (let ((beg (point)) | ||
| 2214 | (eol (progn (end-of-line) (point)))) | ||
| 2215 | (string-to-number (buffer-substring beg eol))))))) | ||
| 2216 | (and size | ||
| 2217 | (if (and (natnump size) | ||
| 2218 | (<= (+ header-end size) (point-max)) | ||
| 2219 | ;; Make sure this would put us at a position | ||
| 2220 | ;; that we could continue from. | ||
| 2221 | (save-excursion | ||
| 2222 | (goto-char (+ header-end size)) | ||
| 2223 | (skip-chars-forward "\n") | ||
| 2224 | (or (eobp) | ||
| 2225 | (and (looking-at "BABYL OPTIONS:") | ||
| 2226 | (search-forward "\n\^_" nil t)) | ||
| 2227 | (and (looking-at "\^L") | ||
| 2228 | (search-forward "\n\^_" nil t)) | ||
| 2229 | (let ((case-fold-search t)) | ||
| 2230 | (looking-at pmail-mmdf-delim1)) | ||
| 2231 | (looking-at "From ")))) | ||
| 2232 | (goto-char (+ header-end size)) | ||
| 2233 | (message "Ignoring invalid Content-Length field") | ||
| 2234 | (sit-for 1 0 t))) | ||
| 2235 | (if (let ((case-fold-search nil)) | ||
| 2236 | (re-search-forward | ||
| 2237 | (concat "^[\^_]?\\(" | ||
| 2238 | pmail-unix-mail-delimiter | ||
| 2239 | "\\|" | ||
| 2240 | pmail-mmdf-delim1 "\\|" | ||
| 2241 | "^BABYL OPTIONS:\\|" | ||
| 2242 | "\^L\n[01],\\)") nil t)) | ||
| 2243 | (goto-char (match-beginning 1)) | ||
| 2244 | (goto-char (point-max))) | ||
| 2245 | (setq count (1+ count)) | ||
| 2246 | (if quoted-printable-header-field-end | ||
| 2247 | (save-excursion | ||
| 2248 | (unless | ||
| 2249 | (mail-unquote-printable-region header-end (point) nil t t) | ||
| 2250 | (message "Malformed MIME quoted-printable message")) | ||
| 2251 | ;; Change "quoted-printable" to "8bit", | ||
| 2252 | ;; to reflect the decoding we just did. | ||
| 2253 | (goto-char quoted-printable-header-field-end) | ||
| 2254 | (delete-region (point) (search-backward ":")) | ||
| 2255 | (insert ": 8bit"))) | ||
| 2256 | (if base64-header-field-end | ||
| 2257 | (save-excursion | ||
| 2258 | (when | ||
| 2259 | (condition-case nil | ||
| 2260 | (progn | ||
| 2261 | (base64-decode-region | ||
| 2262 | (1+ header-end) | ||
| 2263 | (save-excursion | ||
| 2264 | ;; Prevent base64-decode-region | ||
| 2265 | ;; from removing newline characters. | ||
| 2266 | (skip-chars-backward "\n\t ") | ||
| 2267 | (point))) | ||
| 2268 | t) | ||
| 2269 | (error nil)) | ||
| 2270 | ;; Change "base64" to "8bit", to reflect the | ||
| 2271 | ;; decoding we just did. | ||
| 2272 | (goto-char base64-header-field-end) | ||
| 2273 | (delete-region (point) (search-backward ":")) | ||
| 2274 | (insert ": 8bit"))))) | ||
| 2275 | |||
| 2276 | (save-excursion | ||
| 2277 | (save-restriction | ||
| 2278 | (narrow-to-region start (point)) | ||
| 2279 | (goto-char (point-min)) | ||
| 2280 | (while (search-forward "\n\^_" nil t) ; single char | ||
| 2281 | (replace-match "\n^_")))) ; 2 chars: "^" and "_" | ||
| 2282 | ;; This is for malformed messages that don't end in newline. | ||
| 2283 | ;; There shouldn't be any, but some users say occasionally | ||
| 2284 | ;; there are some. | ||
| 2285 | (or (bolp) (newline)) | ||
| 2286 | (insert ?\^_) | ||
| 2287 | (setq last-coding-system-used nil) | ||
| 2288 | (or pmail-enable-mime | ||
| 2289 | (not pmail-enable-multibyte) | ||
| 2290 | (let ((mime-charset | ||
| 2291 | (if (and pmail-decode-mime-charset | ||
| 2292 | (save-excursion | ||
| 2293 | (goto-char start) | ||
| 2294 | (search-forward "\n\n" nil t) | ||
| 2295 | (let ((case-fold-search t)) | ||
| 2296 | (re-search-backward | ||
| 2297 | pmail-mime-charset-pattern | ||
| 2298 | start t)))) | ||
| 2299 | (intern (downcase (match-string 1)))))) | ||
| 2300 | (pmail-decode-region start (point) mime-charset))) | ||
| 2301 | (save-excursion | ||
| 2302 | (goto-char start) | ||
| 2303 | (forward-line 3) | ||
| 2304 | (insert "X-Coding-System: " | ||
| 2305 | (symbol-name last-coding-system-used) | ||
| 2306 | "\n")) | ||
| 2307 | (narrow-to-region (point) (point-max)) | ||
| 2308 | (and (= 0 (% count 10)) | ||
| 2309 | (message "Converting to Babyl format...%d" count))) | ||
| 2310 | ;; | ||
| 2311 | ;; This kludge is because some versions of sendmail.el | ||
| 2312 | ;; insert an extra newline at the beginning that shouldn't | ||
| 2313 | ;; be there. sendmail.el has been fixed, but old versions | ||
| 2314 | ;; may still be in use. -- rms, 7 May 1993. | ||
| 2315 | ((eolp) (delete-char 1)) | ||
| 2316 | (t (error "Cannot convert to babyl format"))))) | ||
| 2317 | (setq buffer-undo-list nil) | ||
| 2318 | count)) | ||
| 2319 | |||
| 2320 | ;; Delete the "From ..." line, creating various other headers with | ||
| 2321 | ;; information from it if they don't already exist. Now puts the | ||
| 2322 | ;; original line into a mail-from: header line for debugging and for | ||
| 2323 | ;; use by the pmail-output function. | ||
| 2324 | (defun pmail-nuke-pinhead-header () | ||
| 2325 | (save-excursion | ||
| 2326 | (save-restriction | ||
| 2327 | (let ((start (point)) | ||
| 2328 | (end (progn | ||
| 2329 | (condition-case () | ||
| 2330 | (search-forward "\n\n") | ||
| 2331 | (error | ||
| 2332 | (goto-char (point-max)) | ||
| 2333 | (insert "\n\n"))) | ||
| 2334 | (point))) | ||
| 2335 | has-from has-date) | ||
| 2336 | (narrow-to-region start end) | ||
| 2337 | (let ((case-fold-search t)) | ||
| 2338 | (goto-char start) | ||
| 2339 | (setq has-from (search-forward "\nFrom:" nil t)) | ||
| 2340 | (goto-char start) | ||
| 2341 | (setq has-date (and (search-forward "\nDate:" nil t) (point))) | ||
| 2342 | (goto-char start)) | ||
| 2343 | (let ((case-fold-search nil)) | ||
| 2344 | (if (re-search-forward (concat "^" pmail-unix-mail-delimiter) nil t) | ||
| 2345 | (replace-match | ||
| 2346 | (concat | ||
| 2347 | "Mail-from: \\&" | ||
| 2348 | ;; Keep and reformat the date if we don't | ||
| 2349 | ;; have a Date: field. | ||
| 2350 | (if has-date | ||
| 2351 | "" | ||
| 2352 | (concat | ||
| 2353 | "Date: \\2, \\4 \\3 \\9 \\5 " | ||
| 2354 | |||
| 2355 | ;; The timezone could be matched by group 7 or group 10. | ||
| 2356 | ;; If neither of them matched, assume EST, since only | ||
| 2357 | ;; Easterners would be so sloppy. | ||
| 2358 | ;; It's a shame the substitution can't use "\\10". | ||
| 2359 | (cond | ||
| 2360 | ((/= (match-beginning 7) (match-end 7)) "\\7") | ||
| 2361 | ((/= (match-beginning 10) (match-end 10)) | ||
| 2362 | (buffer-substring (match-beginning 10) | ||
| 2363 | (match-end 10))) | ||
| 2364 | (t "EST")) | ||
| 2365 | "\n")) | ||
| 2366 | ;; Keep and reformat the sender if we don't | ||
| 2367 | ;; have a From: field. | ||
| 2368 | (if has-from | ||
| 2369 | "" | ||
| 2370 | "From: \\1\n")) | ||
| 2371 | t))))))) | ||
| 1814 | 2372 | ||
| 1815 | ;;;; *** Pmail Message Formatting and Header Manipulation *** | 2373 | ;;;; *** Pmail Message Formatting and Header Manipulation *** |
| 1816 | 2374 | ||
| 1817 | (defun pmail-clear-headers (&optional ignored-headers) | 2375 | (defun pmail-copy-headers (beg end &optional ignored-headers) |
| 1818 | "Delete all header fields that Pmail should not show. | 2376 | "Copy displayed header fields to the message viewer buffer. |
| 1819 | If the optional argument IGNORED-HEADERS is non-nil, | 2377 | BEG and END marks the start and end positions of the message in |
| 1820 | delete all header fields whose names match that regexp. | 2378 | the mail buffer. If the optional argument IGNORED-HEADERS is |
| 1821 | Otherwise, if `pmail-displayed-headers' is non-nil, | 2379 | non-nil, ignore all header fields whose names match that regexp. |
| 1822 | delete all header fields *except* those whose names match that regexp. | 2380 | Otherwise, if `rmail-displayed-headers' is non-nil, copy only |
| 1823 | Otherwise, delete all header fields whose names match `pmail-ignored-headers' | 2381 | those header fields whose names match that regexp. Otherwise, |
| 1824 | unless they also match `pmail-nonignored-headers'." | 2382 | copy all header fields whose names do not match |
| 1825 | (when (search-forward "\n\n" nil t) | 2383 | `rmail-ignored-headers' (unless they also match |
| 1826 | (forward-char -1) | 2384 | `rmail-nonignored-headers')." |
| 1827 | (let ((case-fold-search t) | 2385 | (let ((result "") |
| 1828 | (buffer-read-only nil)) | 2386 | (header-start-regexp "\n[^ \t]") |
| 1829 | (if (and pmail-displayed-headers (null ignored-headers)) | 2387 | lim) |
| 1830 | (save-restriction | 2388 | (with-current-buffer pmail-buffer |
| 1831 | (narrow-to-region (point-min) (point)) | 2389 | (when (search-forward "\n\n" nil t) |
| 1832 | (let (lim next) | 2390 | (forward-char -1) |
| 1833 | (goto-char (point-min)) | ||
| 1834 | (while (and (not (eobp)) | ||
| 1835 | (save-excursion | ||
| 1836 | (if (re-search-forward "\n[^ \t]" nil t) | ||
| 1837 | (setq lim (match-beginning 0) | ||
| 1838 | next (1+ lim)) | ||
| 1839 | (setq lim nil next (point-max))))) | ||
| 1840 | (if (save-excursion | ||
| 1841 | (re-search-forward pmail-displayed-headers lim t)) | ||
| 1842 | (goto-char next) | ||
| 1843 | (delete-region (point) next)))) | ||
| 1844 | (goto-char (point-min))) | ||
| 1845 | (or ignored-headers (setq ignored-headers pmail-ignored-headers)) | ||
| 1846 | (save-restriction | 2391 | (save-restriction |
| 1847 | (narrow-to-region (point-min) (point)) | 2392 | ;; Put point right after the From header line. |
| 2393 | (narrow-to-region beg (point)) | ||
| 1848 | (goto-char (point-min)) | 2394 | (goto-char (point-min)) |
| 1849 | (while (and ignored-headers | 2395 | (unless (re-search-forward header-start-regexp nil t) |
| 1850 | (re-search-forward ignored-headers nil t)) | 2396 | (error "Invalid mbox format; no header follows the From message separator.")) |
| 1851 | (beginning-of-line) | 2397 | (forward-char -1) |
| 1852 | (if (and pmail-nonignored-headers | 2398 | (cond |
| 1853 | (looking-at pmail-nonignored-headers)) | 2399 | ;; Handle the case where all headers should be copied. |
| 1854 | (forward-line 1) | 2400 | ((eq pmail-header-style 'full) |
| 1855 | (delete-region (point) | 2401 | (setq result (buffer-substring beg (point-max)))) |
| 1856 | (save-excursion | 2402 | ;; Handle the case where the headers matching the diplayed |
| 1857 | (if (re-search-forward "\n[^ \t]" nil t) | 2403 | ;; headers regexp should be copied. |
| 1858 | (1- (point)) | 2404 | ((and pmail-displayed-headers (null ignored-headers)) |
| 1859 | (point-max))))))))))) | 2405 | (while (not (eobp)) |
| 1860 | 2406 | (save-excursion | |
| 1861 | (defun pmail-msg-is-pruned (&optional msg) | 2407 | (setq lim (if (re-search-forward header-start-regexp nil t) |
| 1862 | "Determine if the headers for the current message are being | 2408 | (1+ (match-beginning 0)) |
| 1863 | displayed. If MSG is non-nil it will be used as the message number | 2409 | (point-max)))) |
| 1864 | instead of the current message." | 2410 | (when (looking-at pmail-displayed-headers) |
| 1865 | (pmail-desc-get-header-display-state (or msg pmail-current-message))) | 2411 | (setq result (concat result (buffer-substring (point) lim)))) |
| 2412 | (goto-char lim))) | ||
| 2413 | ;; Handle the ignored headers. | ||
| 2414 | ((or ignored-headers (setq ignored-headers pmail-ignored-headers)) | ||
| 2415 | (while (and ignored-headers (not (eobp))) | ||
| 2416 | (save-excursion | ||
| 2417 | (setq lim (if (re-search-forward header-start-regexp nil t) | ||
| 2418 | (1+ (match-beginning 0)) | ||
| 2419 | (point-max)))) | ||
| 2420 | (if (and (looking-at ignored-headers) | ||
| 2421 | (not (looking-at pmail-nonignored-headers))) | ||
| 2422 | (goto-char lim) | ||
| 2423 | (setq result (concat result (buffer-substring (point) lim))) | ||
| 2424 | (goto-char lim)))) | ||
| 2425 | (t (error "No headers selected for display!")))))) | ||
| 2426 | result)) | ||
| 2427 | |||
| 2428 | (defun pmail-copy-body (beg end) | ||
| 2429 | "Return the message body to be displayed in the view buffer. | ||
| 2430 | BEG and END marks the start and end positions of the message in | ||
| 2431 | the mail buffer." | ||
| 2432 | (with-current-buffer pmail-buffer | ||
| 2433 | (if (search-forward "\n\n" nil t) | ||
| 2434 | (buffer-substring (point) end) | ||
| 2435 | (error "Invalid message format: no header/body separator")))) | ||
| 1866 | 2436 | ||
| 1867 | (defun pmail-toggle-header (&optional arg) | 2437 | (defun pmail-toggle-header (&optional arg) |
| 1868 | "Show original message header if pruned header currently shown, or vice versa. | 2438 | "Show original message header if pruned header currently shown, or vice versa. |
| 1869 | With argument ARG, show the message header pruned if ARG is greater than zero; | 2439 | With argument ARG, show the message header pruned if ARG is greater than zero; |
| 1870 | otherwise, show it in full." | 2440 | otherwise, show it in full." |
| 1871 | (interactive "P") | 2441 | (interactive "P") |
| 1872 | (pmail-header-toggle-visibility arg)) | 2442 | (setq pmail-header-style |
| 2443 | (cond | ||
| 2444 | ((and (numberp arg) (> arg 0)) 'normal) | ||
| 2445 | ((eq pmail-header-style 'full) 'normal) | ||
| 2446 | (t 'full))) | ||
| 2447 | (pmail-show-message)) | ||
| 1873 | 2448 | ||
| 1874 | ;; Lifted from repos-count-screen-lines. | 2449 | ;; Lifted from repos-count-screen-lines. |
| 2450 | ;; Return number of screen lines between START and END. | ||
| 1875 | (defun pmail-count-screen-lines (start end) | 2451 | (defun pmail-count-screen-lines (start end) |
| 1876 | "Return number of screen lines between START and END." | ||
| 1877 | (save-excursion | 2452 | (save-excursion |
| 1878 | (save-restriction | 2453 | (save-restriction |
| 1879 | (narrow-to-region start end) | 2454 | (narrow-to-region start end) |
| @@ -1882,22 +2457,64 @@ otherwise, show it in full." | |||
| 1882 | 2457 | ||
| 1883 | ;;;; *** Pmail Attributes and Keywords *** | 2458 | ;;;; *** Pmail Attributes and Keywords *** |
| 1884 | 2459 | ||
| 1885 | ;; Make a string describing the current message's attributes by | 2460 | (defun pmail-get-header (name &optional msg) |
| 1886 | ;; keywords and set it up as the name of a minor mode so it will | 2461 | "Return the value of message header NAME, nil if no such header |
| 1887 | ;; appear in the mode line. | 2462 | exists. MSG, if set identifies the message number to use. The |
| 2463 | current mail message will be used otherwise." | ||
| 2464 | (save-excursion | ||
| 2465 | (save-restriction | ||
| 2466 | (with-current-buffer pmail-buffer | ||
| 2467 | (widen) | ||
| 2468 | (let* ((n (or msg pmail-current-message)) | ||
| 2469 | (beg (pmail-msgbeg n)) | ||
| 2470 | end) | ||
| 2471 | (goto-char beg) | ||
| 2472 | (setq end (search-forward "\n\n" nil t)) | ||
| 2473 | (if end | ||
| 2474 | (progn | ||
| 2475 | (narrow-to-region beg end) | ||
| 2476 | (mail-fetch-field name)) | ||
| 2477 | (error "Invalid mbox format encountered."))))))) | ||
| 2478 | |||
| 2479 | (defun pmail-get-attr-names (&optional msg) | ||
| 2480 | "Return the message attributes in a comma separated string. | ||
| 2481 | MSG, if set identifies the message number to use. The current | ||
| 2482 | mail message will be used otherwise." | ||
| 2483 | (let ((value (pmail-get-header pmail-attribute-field-name msg)) | ||
| 2484 | result temp) | ||
| 2485 | (dotimes (index (length value)) | ||
| 2486 | (setq temp (and (not (= ?- (aref value index))) | ||
| 2487 | (nth 1 (aref pmail-attr-array index))) | ||
| 2488 | result | ||
| 2489 | (cond | ||
| 2490 | ((and temp result) (format "%s, %s" result temp)) | ||
| 2491 | (temp temp) | ||
| 2492 | (t result)))) | ||
| 2493 | result)) | ||
| 2494 | |||
| 2495 | (defun pmail-get-keywords (&optional msg) | ||
| 2496 | "Return the message keywords in a comma separated string. | ||
| 2497 | MSG, if set identifies the message number to use. The current | ||
| 2498 | mail message will be used otherwise." | ||
| 2499 | (pmail-get-header pmail-keyword-header msg)) | ||
| 2500 | |||
| 1888 | (defun pmail-display-labels () | 2501 | (defun pmail-display-labels () |
| 1889 | (let (keyword-list result) | 2502 | "Update the mode line with the (set) attributes and keywords |
| 1890 | ;; Update the keyword list for the current message. | 2503 | for the current message." |
| 1891 | (if (> pmail-current-message 0) | 2504 | (let (blurb attr-names keywords) |
| 1892 | (setq keyword-list (pmail-desc-get-keywords pmail-current-message))) | 2505 | ;; Combine the message attributes and keywords into a comma |
| 1893 | ;; Generate the result string. | 2506 | ;; separated list. |
| 1894 | (setq result (mapconcat 'identity keyword-list " ")) | 2507 | (setq attr-names (pmail-get-attr-names pmail-current-message) |
| 1895 | ;; Update the mode line to display the keywords, the current | 2508 | keywords (pmail-get-keywords pmail-current-message)) |
| 1896 | ;; message index and the total number of messages. | 2509 | (setq blurb |
| 2510 | (cond | ||
| 2511 | ((and attr-names keywords) (concat attr-names ", " keywords)) | ||
| 2512 | (attr-names attr-names) | ||
| 2513 | (keywords keywords) | ||
| 2514 | (t ""))) | ||
| 1897 | (setq mode-line-process | 2515 | (setq mode-line-process |
| 1898 | (format " %d/%d%s" | 2516 | (format " %d/%d%s" |
| 1899 | pmail-current-message pmail-total-messages | 2517 | pmail-current-message pmail-total-messages blurb)) |
| 1900 | (if keyword-list (concat " " result) ""))) | ||
| 1901 | ;; If pmail-enable-mime is non-nil, we may have to update | 2518 | ;; If pmail-enable-mime is non-nil, we may have to update |
| 1902 | ;; `mode-line-process' of pmail-view-buffer too. | 2519 | ;; `mode-line-process' of pmail-view-buffer too. |
| 1903 | (if (and pmail-enable-mime | 2520 | (if (and pmail-enable-mime |
| @@ -1907,38 +2524,74 @@ otherwise, show it in full." | |||
| 1907 | (with-current-buffer pmail-view-buffer | 2524 | (with-current-buffer pmail-view-buffer |
| 1908 | (setq mode-line-process mlp)))))) | 2525 | (setq mode-line-process mlp)))))) |
| 1909 | 2526 | ||
| 2527 | (defun pmail-get-attr-value (attr state) | ||
| 2528 | "Return the character value for ATTR. | ||
| 2529 | ATTR is a (numberic) index, an offset into the mbox attribute | ||
| 2530 | header value. STATE is one of nil, t, or a character value." | ||
| 2531 | (cond | ||
| 2532 | ((numberp state) state) | ||
| 2533 | ((not state) ?-) | ||
| 2534 | (t (nth 0 (aref pmail-attr-array attr))))) | ||
| 2535 | |||
| 1910 | (defun pmail-set-attribute (attr state &optional msgnum) | 2536 | (defun pmail-set-attribute (attr state &optional msgnum) |
| 1911 | "Turn a attribute ATTR of a message on or off according to STATE. | 2537 | "Turn an attribute of a message on or off according to STATE. |
| 1912 | ATTR is a string, MSGNUM is the optional message number. By | 2538 | STATE is either nil or the character (numeric) value associated |
| 1913 | default, the current message is changed." | 2539 | with the state (nil represents off and non-nil represents on). |
| 2540 | ATTR is the index of the attribute. MSGNUM is message number to | ||
| 2541 | change; nil means current message." | ||
| 2542 | (set-buffer pmail-buffer) | ||
| 2543 | (let ((value (pmail-get-attr-value attr state)) | ||
| 2544 | (omax (point-max-marker)) | ||
| 2545 | (omin (point-min-marker)) | ||
| 2546 | (buffer-read-only nil) | ||
| 2547 | limit) | ||
| 2548 | (or msgnum (setq msgnum pmail-current-message)) | ||
| 2549 | (if (> msgnum 0) | ||
| 2550 | (unwind-protect | ||
| 2551 | (save-excursion | ||
| 2552 | ;; Determine if the current state is the desired state. | ||
| 2553 | (widen) | ||
| 2554 | (goto-char (pmail-msgbeg msgnum)) | ||
| 2555 | (save-excursion | ||
| 2556 | (setq limit (search-forward "\n\n" nil t))) | ||
| 2557 | (when (search-forward (concat pmail-attribute-header ": ") limit t) | ||
| 2558 | (forward-char attr) | ||
| 2559 | (when (/= value (char-after)) | ||
| 2560 | (delete-char 1) | ||
| 2561 | (insert value))) | ||
| 2562 | (if (= attr pmail-deleted-attr-index) | ||
| 2563 | (pmail-set-message-deleted-p msgnum state))) | ||
| 2564 | ;; Note: we don't use save-restriction because that does not work right | ||
| 2565 | ;; if changes are made outside the saved restriction | ||
| 2566 | ;; before that restriction is restored. | ||
| 2567 | (narrow-to-region omin omax) | ||
| 2568 | (set-marker omin nil) | ||
| 2569 | (set-marker omax nil) | ||
| 2570 | (if (= msgnum pmail-current-message) | ||
| 2571 | (pmail-display-labels)))))) | ||
| 2572 | |||
| 2573 | (defun pmail-message-attr-p (msg attrs) | ||
| 2574 | "Return t if the attributes header for message MSG contains a | ||
| 2575 | match for the regexp ATTRS." | ||
| 1914 | (save-excursion | 2576 | (save-excursion |
| 1915 | (save-restriction | 2577 | (save-restriction |
| 1916 | (let ((attr-index (pmail-desc-get-attr-index attr))) | 2578 | (let ((start (pmail-msgbeg msg)) |
| 1917 | (set-buffer pmail-buffer) | 2579 | limit) |
| 1918 | (or msgnum (setq msgnum pmail-current-message)) | 2580 | (widen) |
| 1919 | (pmail-desc-set-attribute msgnum attr-index state) | 2581 | (goto-char start) |
| 1920 | ;; Deal with the summary buffer. | 2582 | (setq limit (search-forward "\n\n" (pmail-msgend msg) t)) |
| 1921 | (when pmail-summary-buffer | 2583 | (goto-char start) |
| 1922 | (pmail-summary-update msgnum)))))) | 2584 | (and limit |
| 1923 | 2585 | (search-forward (concat pmail-attribute-header ": ") limit t) | |
| 1924 | (defun pmail-message-labels-p (n labels) | 2586 | (looking-at attrs)))))) |
| 1925 | "Return t if message number N has keywords matching LABELS. | ||
| 1926 | LABELS is a regular expression." | ||
| 1927 | (catch 'found | ||
| 1928 | (dolist (keyword (pmail-desc-get-keywords n)) | ||
| 1929 | (when (string-match labels keyword) | ||
| 1930 | (throw 'found t))))) | ||
| 1931 | |||
| 1932 | 2587 | ||
| 1933 | ;;;; *** Pmail Message Selection And Support *** | 2588 | ;;;; *** Pmail Message Selection And Support *** |
| 1934 | 2589 | ||
| 1935 | (defun pmail-msgbeg (n) | ||
| 1936 | (pmail-desc-get-start n)) | ||
| 1937 | (make-obsolete 'pmail-msgbeg 'pmail-desc-get-start "22.0") | ||
| 1938 | |||
| 1939 | (defun pmail-msgend (n) | 2590 | (defun pmail-msgend (n) |
| 1940 | (pmail-desc-get-end n)) | 2591 | (marker-position (aref pmail-message-vector (1+ n)))) |
| 1941 | (make-obsolete 'pmail-msgend 'pmail-desc-get-end "22.0") | 2592 | |
| 2593 | (defun pmail-msgbeg (n) | ||
| 2594 | (marker-position (aref pmail-message-vector n))) | ||
| 1942 | 2595 | ||
| 1943 | (defun pmail-widen-to-current-msgbeg (function) | 2596 | (defun pmail-widen-to-current-msgbeg (function) |
| 1944 | "Call FUNCTION with point at start of internal data of current message. | 2597 | "Call FUNCTION with point at start of internal data of current message. |
| @@ -1951,132 +2604,145 @@ change the invisible header text." | |||
| 1951 | (save-excursion | 2604 | (save-excursion |
| 1952 | (unwind-protect | 2605 | (unwind-protect |
| 1953 | (progn | 2606 | (progn |
| 1954 | (narrow-to-region (pmail-desc-get-start pmail-current-message) | 2607 | (narrow-to-region (pmail-msgbeg pmail-current-message) |
| 1955 | (point-max)) | 2608 | (point-max)) |
| 1956 | (goto-char (point-min)) | 2609 | (goto-char (point-min)) |
| 1957 | (funcall function)) | 2610 | (funcall function)) |
| 1958 | ;; Note: we don't use save-restriction because that does not work right | 2611 | ;; Note: we don't use save-restriction because that does not work right |
| 1959 | ;; if changes are made outside the saved restriction | 2612 | ;; if changes are made outside the saved restriction |
| 1960 | ;; before that restriction is restored. | 2613 | ;; before that restriction is restored. |
| 1961 | (narrow-to-region (pmail-desc-get-start pmail-current-message) | 2614 | (narrow-to-region (pmail-msgbeg pmail-current-message) |
| 1962 | (pmail-desc-get-end pmail-current-message))))) | 2615 | (pmail-msgend pmail-current-message))))) |
| 1963 | 2616 | ||
| 1964 | (defun pmail-process-new-messages (&optional nomsg) | 2617 | (defun pmail-forget-messages () |
| 1965 | "Process the new messages in the buffer. | 2618 | (unwind-protect |
| 1966 | The buffer has been narrowed to expose only the new messages. | 2619 | (if (vectorp pmail-message-vector) |
| 1967 | For each new message append an entry to the message vector and, | 2620 | (let* ((i 0) |
| 1968 | if necessary, add a header that will capture the salient BABYL | 2621 | (v pmail-message-vector) |
| 1969 | information. Return the number of new messages. If NOMSG is | 2622 | (n (length v))) |
| 1970 | non-nil then do not show any progress messages." | 2623 | (while (< i n) |
| 1971 | (let ((inhibit-read-only t) | 2624 | (move-marker (aref v i) nil) |
| 1972 | (case-fold-search nil) | 2625 | (setq i (1+ i))))) |
| 1973 | (new-message-counter 0) | 2626 | (setq pmail-message-vector nil) |
| 1974 | (start (point-max)) | 2627 | (setq pmail-msgref-vector nil) |
| 1975 | end date keywords message-descriptor-list) | 2628 | (setq pmail-deleted-vector nil))) |
| 1976 | (or nomsg (message "Processing new messages...")) | 2629 | |
| 1977 | ;; Process each message in turn starting from the back and | 2630 | (defun pmail-maybe-set-message-counters () |
| 1978 | ;; proceeding to the front of the region. This is especially a | 2631 | (if (not (and pmail-deleted-vector |
| 1979 | ;; good approach since the buffer will likely have new headers | 2632 | pmail-message-vector |
| 1980 | ;; added. | 2633 | pmail-current-message |
| 1981 | (save-excursion | 2634 | pmail-total-messages)) |
| 1982 | (goto-char start) | 2635 | (pmail-set-message-counters))) |
| 1983 | (while (re-search-backward pmail-unix-mail-delimiter nil t) | 2636 | |
| 1984 | ;; Cache the message date to facilitate generating a message | 2637 | (defun pmail-count-new-messages (&optional nomsg) |
| 1985 | ;; summary later. The format is '(DAY-OF-WEEK DAY-NUMBER MON | 2638 | "Count the number of new messages in the region. |
| 1986 | ;; YEAR TIME) | 2639 | Output a helpful message unless NOMSG is non-nil." |
| 1987 | (setq date | 2640 | (let* ((case-fold-search nil) |
| 1988 | (list (buffer-substring (match-beginning 2) (match-end 2)) | 2641 | (total-messages 0) |
| 1989 | (buffer-substring (match-beginning 4) (match-end 4)) | 2642 | (messages-head nil) |
| 1990 | (buffer-substring (match-beginning 3) (match-end 3)) | 2643 | (deleted-head nil)) |
| 1991 | (buffer-substring (match-beginning 7) (match-end 7)) | 2644 | (or nomsg (message "Counting new messages...")) |
| 1992 | (buffer-substring (match-beginning 5) (match-end 5)))) | 2645 | (goto-char (point-max)) |
| 1993 | ;;Set start and end to bracket this message. | 2646 | ;; Put at the end of messages-head |
| 1994 | (setq end start) | 2647 | ;; the entry for message N+1, which marks |
| 1995 | (setq start (point)) | 2648 | ;; the end of message N. (N = number of messages). |
| 1996 | (save-excursion | 2649 | (setq messages-head (list (point-marker))) |
| 1997 | (save-restriction | 2650 | (pmail-set-message-counters-counter (point-min)) |
| 1998 | (narrow-to-region start end) | 2651 | (setq pmail-current-message (1+ pmail-total-messages)) |
| 1999 | (goto-char start) | 2652 | (setq pmail-total-messages |
| 2000 | ;; Bump the new message counter. | 2653 | (+ pmail-total-messages total-messages)) |
| 2001 | (setq new-message-counter (1+ new-message-counter)) | 2654 | (setq pmail-message-vector |
| 2002 | 2655 | (vconcat pmail-message-vector (cdr messages-head))) | |
| 2003 | ;; Set up keywords, if any. The keywords are provided via a | 2656 | (aset pmail-message-vector |
| 2004 | ;; comma separated list and returned as a list of strings. | 2657 | pmail-current-message (car messages-head)) |
| 2005 | (setq keywords (pmail-header-get-keywords)) | 2658 | (setq pmail-deleted-vector |
| 2006 | (when keywords | 2659 | (concat pmail-deleted-vector deleted-head)) |
| 2007 | ;; Keywords do exist. Register them with the keyword | 2660 | (setq pmail-summary-vector |
| 2008 | ;; management library. | 2661 | (vconcat pmail-summary-vector (make-vector total-messages nil))) |
| 2009 | (pmail-register-keywords keywords)) | 2662 | (setq pmail-msgref-vector |
| 2010 | ;; Insure that we have From and Date headers. | 2663 | (vconcat pmail-msgref-vector (make-vector total-messages nil))) |
| 2011 | ;;(pmail-decode-from-line) | 2664 | ;; Fill in the new elements of pmail-msgref-vector. |
| 2012 | ;; Perform User defined filtering. | 2665 | (let ((i (1+ (- pmail-total-messages total-messages)))) |
| 2013 | (save-excursion | 2666 | (while (<= i pmail-total-messages) |
| 2014 | (if pmail-message-filter (funcall pmail-message-filter))) | 2667 | (aset pmail-msgref-vector i (list i)) |
| 2015 | ;; Accumulate the message attributes along with the message | 2668 | (setq i (1+ i)))) |
| 2016 | ;; markers and the message date list. | 2669 | (goto-char (point-min)) |
| 2017 | (setq message-descriptor-list | 2670 | (or nomsg (message "Counting new messages...done (%d)" total-messages)))) |
| 2018 | (vconcat (list (list (point-min-marker) | 2671 | |
| 2019 | (pmail-header-get-header | 2672 | (defun pmail-set-message-counters () |
| 2020 | pmail-header-attribute-header) | 2673 | (pmail-forget-messages) |
| 2021 | keywords | 2674 | (save-excursion |
| 2022 | date | 2675 | (save-restriction |
| 2023 | (count-lines start end) | 2676 | (widen) |
| 2024 | (cadr (mail-extract-address-components; does not like nil | 2677 | (let* ((point-save (point)) |
| 2025 | (or (pmail-header-get-header "from") ""))) | 2678 | (total-messages 0) |
| 2026 | (or (pmail-header-get-header "subject") | 2679 | (messages-after-point) |
| 2027 | "none"))) | 2680 | (case-fold-search nil) |
| 2028 | message-descriptor-list))))) | 2681 | (messages-head nil) |
| 2029 | ;; Add the new message data lists to the Pmail message descriptor | 2682 | (deleted-head nil)) |
| 2030 | ;; vector. | 2683 | ;; Determine how many messages follow point. |
| 2031 | (pmail-desc-add-descriptors message-descriptor-list) | 2684 | (message "Counting messages...") |
| 2032 | ;; Unless requested otherwise, show the number of new messages. | 2685 | (goto-char (point-max)) |
| 2033 | ;; Return the number of new messages. | 2686 | ;; Put at the end of messages-head |
| 2034 | (or nomsg (message "Processing new messages...done (%d)" | 2687 | ;; the entry for message N+1, which marks |
| 2035 | new-message-counter)) | 2688 | ;; the end of message N. (N = number of messages). |
| 2036 | new-message-counter))) | 2689 | (setq messages-head (list (point-marker))) |
| 2037 | 2690 | (pmail-set-message-counters-counter (min (point) point-save)) | |
| 2038 | (defun pmail-convert-mbox-format () | 2691 | (setq messages-after-point total-messages) |
| 2039 | (let ((case-fold-search nil) | 2692 | |
| 2040 | (message-count 0) | 2693 | ;; Determine how many precede point. |
| 2041 | (start (point-max)) | 2694 | (pmail-set-message-counters-counter) |
| 2042 | end) | 2695 | (setq pmail-total-messages total-messages) |
| 2043 | (save-excursion | 2696 | (setq pmail-current-message |
| 2044 | (goto-char start) | 2697 | (min total-messages |
| 2045 | (while (re-search-backward pmail-unix-mail-delimiter nil t) | 2698 | (max 1 (- total-messages messages-after-point)))) |
| 2046 | (setq end start) | 2699 | (setq pmail-message-vector |
| 2047 | (setq start (point)) | 2700 | (apply 'vector (cons (point-min-marker) messages-head)) |
| 2048 | (save-excursion | 2701 | pmail-deleted-vector (concat "0" deleted-head) |
| 2049 | (save-restriction | 2702 | pmail-summary-vector (make-vector pmail-total-messages nil) |
| 2050 | (narrow-to-region start end) | 2703 | pmail-msgref-vector (make-vector (1+ pmail-total-messages) nil)) |
| 2051 | (goto-char (point-min)) | 2704 | (let ((i 0)) |
| 2052 | ;; Bump the new message counter. | 2705 | (while (<= i pmail-total-messages) |
| 2053 | (setq message-count (1+ message-count)) | 2706 | (aset pmail-msgref-vector i (list i)) |
| 2054 | ;; Detect messages that have been added with DOS line endings | 2707 | (setq i (1+ i)))) |
| 2055 | ;; and convert the line endings for such messages. | 2708 | (message "Counting messages...done"))))) |
| 2056 | (when (save-excursion (end-of-line) (= (preceding-char) ?\r)) | 2709 | |
| 2057 | (let ((buffer-read-only nil) | 2710 | |
| 2058 | (buffer-undo t) | 2711 | (defsubst pmail-collect-deleted (message-end) |
| 2059 | (end-marker (copy-marker end))) | 2712 | "Collect the message deletion flags for each message. |
| 2060 | (message | 2713 | MESSAGE-END is the buffer position corresponding to the end of |
| 2061 | "Processing new messages...(converting line endings)") | 2714 | the message. Point is at the beginning of the message." |
| 2062 | (save-excursion | 2715 | ;; NOTE: This piece of code will be executed on a per-message basis. |
| 2063 | (goto-char (point-max)) | 2716 | ;; In the face of thousands of messages, it has to be as fast as |
| 2064 | (while (search-backward "\r\n" (point-min) t) | 2717 | ;; possible, hence some brute force constant use is employed in |
| 2065 | (delete-char 1))) | 2718 | ;; addition to inlining. |
| 2066 | (setq end (marker-position end-marker)) | 2719 | (save-excursion |
| 2067 | (set-marker end-marker nil))) | 2720 | (setq deleted-head |
| 2068 | ;; Make sure we have an Pmail BABYL attribute header field. | 2721 | (cons (if (and (search-forward "X-BABYL-V6-ATTRIBUTES: " message-end t) |
| 2069 | ;; All we can assume is that the Pmail BABYL header field is | 2722 | (looking-at "?D")) |
| 2070 | ;; in the header section. It's placement can be modified by | 2723 | ?D |
| 2071 | ;; another mailer. | 2724 | ?\ ) deleted-head)))) |
| 2072 | (let ((attributes (pmail-header-get-header | 2725 | |
| 2073 | pmail-header-attribute-header))) | 2726 | (defun pmail-set-message-counters-counter (&optional stop) |
| 2074 | (unless attributes | 2727 | ;; Collect the start position for each message into 'messages-head. |
| 2075 | ;; No suitable header exists. Append the default BABYL | 2728 | (let ((start (point))) |
| 2076 | ;; data header for a new message. | 2729 | (while (search-backward "\n\nFrom " stop t) |
| 2077 | (pmail-header-add-header pmail-header-attribute-header | 2730 | (forward-char 2) |
| 2078 | pmail-desc-default-attrs)))))) | 2731 | (pmail-collect-deleted start) |
| 2079 | message-count))) | 2732 | ;; Show progress after every 20 messages or so. |
| 2733 | (setq messages-head (cons (point-marker) messages-head) | ||
| 2734 | total-messages (1+ total-messages) | ||
| 2735 | start (point)) | ||
| 2736 | (if (zerop (% total-messages 20)) | ||
| 2737 | (message "Counting messages...%d" total-messages))) | ||
| 2738 | ;; Handle the first message, maybe. | ||
| 2739 | (if stop | ||
| 2740 | (goto-char stop) | ||
| 2741 | (goto-char (point-min))) | ||
| 2742 | (unless (not (looking-at "From ")) | ||
| 2743 | (pmail-collect-deleted start) | ||
| 2744 | (setq messages-head (cons (point-marker) messages-head) | ||
| 2745 | total-messages (1+ total-messages))))) | ||
| 2080 | 2746 | ||
| 2081 | (defun pmail-beginning-of-message () | 2747 | (defun pmail-beginning-of-message () |
| 2082 | "Show current message starting from the beginning." | 2748 | "Show current message starting from the beginning." |
| @@ -2098,38 +2764,58 @@ non-nil then do not show any progress messages." | |||
| 2098 | (defun pmail-unknown-mail-followup-to () | 2764 | (defun pmail-unknown-mail-followup-to () |
| 2099 | "Handle a \"Mail-Followup-To\" header field with an unknown mailing list. | 2765 | "Handle a \"Mail-Followup-To\" header field with an unknown mailing list. |
| 2100 | Ask the user whether to add that list name to `mail-mailing-lists'." | 2766 | Ask the user whether to add that list name to `mail-mailing-lists'." |
| 2101 | (save-restriction | 2767 | (save-restriction |
| 2102 | (let ((mail-followup-to (pmail-header-get-header "mail-followup-to" nil t))) | 2768 | (let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t))) |
| 2103 | (when mail-followup-to | 2769 | (when mail-followup-to |
| 2104 | (let ((addresses | 2770 | (let ((addresses |
| 2105 | (split-string | 2771 | (split-string |
| 2106 | (mail-strip-quoted-names mail-followup-to) | 2772 | (mail-strip-quoted-names mail-followup-to) |
| 2107 | ",[[:space:]]+" t))) | 2773 | ",[[:space:]]+" t))) |
| 2108 | (dolist (addr addresses) | 2774 | (dolist (addr addresses) |
| 2109 | (when (and (not (member addr mail-mailing-lists)) | 2775 | (when (and (not (member addr mail-mailing-lists)) |
| 2110 | (and pmail-user-mail-address-regexp | 2776 | (not |
| 2111 | (not (string-match pmail-user-mail-address-regexp | 2777 | ;; taken from pmailsum.el |
| 2112 | addr))) | 2778 | (string-match |
| 2113 | (y-or-n-p | 2779 | (or pmail-user-mail-address-regexp |
| 2114 | (format "Add `%s' to `mail-mailing-lists'? " | 2780 | (concat "^\\(" |
| 2115 | addr))) | 2781 | (regexp-quote (user-login-name)) |
| 2116 | (customize-save-variable 'mail-mailing-lists | 2782 | "\\($\\|@\\)\\|" |
| 2117 | (cons addr mail-mailing-lists))))))))) | 2783 | (regexp-quote |
| 2784 | (or user-mail-address | ||
| 2785 | (concat (user-login-name) "@" | ||
| 2786 | (or mail-host-address | ||
| 2787 | (system-name))))) | ||
| 2788 | "\\>\\)")) | ||
| 2789 | addr)) | ||
| 2790 | (y-or-n-p | ||
| 2791 | (format "Add `%s' to `mail-mailing-lists'? " | ||
| 2792 | addr))) | ||
| 2793 | (customize-save-variable 'mail-mailing-lists | ||
| 2794 | (cons addr mail-mailing-lists))))))))) | ||
| 2795 | |||
| 2796 | (defun pmail-swap-buffers-maybe () | ||
| 2797 | "Determine if the Pmail buffer is showing a message. | ||
| 2798 | If so restore the actual mbox message collection." | ||
| 2799 | (unless (not pmail-buffers-swapped-p) | ||
| 2800 | (with-current-buffer pmail-buffer | ||
| 2801 | (buffer-swap-text pmail-view-buffer) | ||
| 2802 | (setq pmail-buffers-swapped-p nil)))) | ||
| 2118 | 2803 | ||
| 2119 | (defun pmail-show-message (&optional n no-summary) | 2804 | (defun pmail-show-message (&optional n no-summary) |
| 2120 | "Show message number N (prefix argument), counting from start of file. | 2805 | "Show message number N (prefix argument), counting from start of file. |
| 2121 | If NO-SUMMARY is non-nil, then do not update the summary buffer." | 2806 | If summary buffer is currently displayed, update current message there also." |
| 2122 | (interactive "p") | 2807 | (interactive "p") |
| 2123 | (unless (eq major-mode 'pmail-mode) | 2808 | (or (eq major-mode 'pmail-mode) |
| 2124 | (switch-to-buffer pmail-buffer)) | 2809 | (switch-to-buffer pmail-buffer)) |
| 2125 | (if (zerop pmail-total-messages) | 2810 | (pmail-swap-buffers-maybe) |
| 2126 | (progn | 2811 | (pmail-maybe-set-message-counters) |
| 2127 | (message "No messages to show. Add something better soon.") | 2812 | (widen) |
| 2128 | (force-mode-line-update)) | 2813 | (let (blurb) |
| 2129 | (let (blurb) | 2814 | (if (zerop pmail-total-messages) |
| 2130 | ;; Set n to the first sane message based on the sign of n: | 2815 | (save-excursion |
| 2131 | ;; positive but greater than the total number of messages -> n; | 2816 | (with-current-buffer pmail-view-buffer |
| 2132 | ;; negative -> 1. | 2817 | (erase-buffer) |
| 2818 | (setq blurb "No mail."))) | ||
| 2133 | (if (not n) | 2819 | (if (not n) |
| 2134 | (setq n pmail-current-message) | 2820 | (setq n pmail-current-message) |
| 2135 | (cond ((<= n 0) | 2821 | (cond ((<= n 0) |
| @@ -2142,114 +2828,104 @@ If NO-SUMMARY is non-nil, then do not update the summary buffer." | |||
| 2142 | blurb "No following message")) | 2828 | blurb "No following message")) |
| 2143 | (t | 2829 | (t |
| 2144 | (setq pmail-current-message n)))) | 2830 | (setq pmail-current-message n)))) |
| 2145 | (let ((beg (pmail-desc-get-start n)) | 2831 | (let ((buf pmail-buffer) |
| 2146 | (end (pmail-desc-get-end n))) | 2832 | (beg (pmail-msgbeg n)) |
| 2147 | (pmail-header-show-headers) | 2833 | (end (pmail-msgend n)) |
| 2148 | (widen) | 2834 | headers body) |
| 2149 | (narrow-to-region beg end) | 2835 | (goto-char beg) |
| 2150 | (goto-char (point-min)) | 2836 | (setq headers (pmail-copy-headers beg end) |
| 2151 | ;; Clear the "unseen" attribute when we show a message, unless | 2837 | body (pmail-copy-body beg end)) |
| 2152 | ;; it is already cleared. | 2838 | (pmail-set-attribute pmail-unseen-attr-index nil) |
| 2153 | (when (pmail-desc-attr-p pmail-desc-unseen-index n) | 2839 | (with-current-buffer pmail-view-buffer |
| 2154 | (pmail-desc-set-attribute n pmail-desc-unseen-index nil)) | 2840 | (erase-buffer) |
| 2155 | (pmail-display-labels) | 2841 | (insert headers "\n") |
| 2156 | ;; Deal with MIME | 2842 | (pmail-highlight-headers) |
| 2157 | (if (eq pmail-enable-mime t) | 2843 | (insert body) |
| 2158 | (funcall pmail-show-mime-function) | 2844 | (goto-char (point-min))))) |
| 2159 | (setq pmail-view-buffer pmail-buffer)) | 2845 | (when mail-mailing-lists |
| 2160 | (when mail-mailing-lists | 2846 | (pmail-unknown-mail-followup-to)) |
| 2161 | (pmail-unknown-mail-followup-to)) | 2847 | (if transient-mark-mode (deactivate-mark)) |
| 2162 | (pmail-header-hide-headers) | 2848 | (pmail-display-labels) |
| 2163 | (when transient-mark-mode (deactivate-mark)) | 2849 | (buffer-swap-text pmail-view-buffer) |
| 2164 | ;; Make sure that point in the Pmail window is at the beginning | 2850 | (setq pmail-buffers-swapped-p t) |
| 2165 | ;; of the buffer. | 2851 | (run-hooks 'pmail-show-message-hook) |
| 2166 | (goto-char (point-min)) | 2852 | ;; If there is a summary buffer, try to move to this message |
| 2167 | (set-window-point (get-buffer-window pmail-buffer) (point)) | 2853 | ;; in that buffer. But don't complain if this message |
| 2168 | ;; Run any User code. | 2854 | ;; is not mentioned in the summary. |
| 2169 | (run-hooks 'pmail-show-message-hook) | 2855 | ;; Don't do this at all if we were called on behalf |
| 2170 | ;; If there is a summary buffer, try to move to this message in | 2856 | ;; of cursor motion in the summary buffer. |
| 2171 | ;; that buffer. But don't complain if this message is not | 2857 | (and (pmail-summary-exists) (not no-summary) |
| 2172 | ;; mentioned in the summary. Don't do this at all if we were | 2858 | (let ((curr-msg pmail-current-message)) |
| 2173 | ;; called on behalf of cursor motion in the summary buffer. | 2859 | (pmail-select-summary |
| 2174 | (when (and (pmail-summary-exists) (not no-summary)) | 2860 | (pmail-summary-goto-msg curr-msg t t)))) |
| 2175 | (let ((curr-msg pmail-current-message)) | ||
| 2176 | ;; Set the summary current message, disabling the Pmail | ||
| 2177 | ;; buffer update. | ||
| 2178 | (with-current-buffer pmail-summary-buffer | ||
| 2179 | (pmail-summary-goto-msg curr-msg nil t)))) | ||
| 2180 | (with-current-buffer pmail-buffer | ||
| 2181 | (pmail-auto-file)) | ||
| 2182 | ;; Post back any status messages. | ||
| 2183 | (when blurb | ||
| 2184 | (message blurb)))))) | ||
| 2185 | |||
| 2186 | (defun pmail-redecode-body (coding) | ||
| 2187 | "Decode the body of the current message using coding system CODING. | ||
| 2188 | This is useful with mail messages that have malformed or missing | ||
| 2189 | charset= headers. | ||
| 2190 | |||
| 2191 | This function assumes that the current message is already decoded | ||
| 2192 | and displayed in the PMAIL buffer, but the coding system used to | ||
| 2193 | decode it was incorrect. It then encodes the message back to its | ||
| 2194 | original form, and decodes it again, using the coding system CODING. | ||
| 2195 | |||
| 2196 | Note that if Emacs erroneously auto-detected one of the iso-2022 | ||
| 2197 | encodings in the message, this function might fail because the escape | ||
| 2198 | sequences that switch between character sets and also single-shift and | ||
| 2199 | locking-shift codes are impossible to recover. This function is meant | ||
| 2200 | to be used to fix messages encoded with 8-bit encodings, such as | ||
| 2201 | iso-8859, koi8-r, etc." | ||
| 2202 | (interactive "zCoding system for re-decoding this message: ") | ||
| 2203 | (unless pmail-enable-mime | ||
| 2204 | (with-current-buffer pmail-buffer | 2861 | (with-current-buffer pmail-buffer |
| 2862 | (pmail-auto-file)) | ||
| 2863 | (if blurb | ||
| 2864 | (message blurb)))) | ||
| 2865 | |||
| 2866 | ;; Find all occurrences of certain fields, and highlight them. | ||
| 2867 | (defun pmail-highlight-headers () | ||
| 2868 | ;; Do this only if the system supports faces. | ||
| 2869 | (if (and (fboundp 'internal-find-face) | ||
| 2870 | pmail-highlighted-headers) | ||
| 2205 | (save-excursion | 2871 | (save-excursion |
| 2206 | (let ((start (pmail-desc-get-start pmail-current-message)) | 2872 | (search-forward "\n\n" nil 'move) |
| 2207 | (end (pmail-desc-get-end pmail-current-message)) | 2873 | (save-restriction |
| 2208 | header) | 2874 | (narrow-to-region (point-min) (point)) |
| 2209 | (narrow-to-region start end) | 2875 | (let ((case-fold-search t) |
| 2210 | (setq header (pmail-header-get-header "X-Coding-System")) | 2876 | (inhibit-read-only t) |
| 2211 | (if header | 2877 | ;; Highlight with boldface if that is available. |
| 2212 | (let ((old-coding (intern header)) | 2878 | ;; Otherwise use the `highlight' face. |
| 2213 | (buffer-read-only nil)) | 2879 | (face (or 'pmail-highlight |
| 2214 | (check-coding-system old-coding) | 2880 | (if (face-differs-from-default-p 'bold) |
| 2215 | ;; Make sure the new coding system uses the same EOL | 2881 | 'bold 'highlight))) |
| 2216 | ;; conversion, to prevent ^M characters from popping | 2882 | ;; List of overlays to reuse. |
| 2217 | ;; up all over the place. | 2883 | (overlays pmail-overlay-list)) |
| 2218 | (setq coding | 2884 | (goto-char (point-min)) |
| 2219 | (coding-system-change-eol-conversion | 2885 | (while (re-search-forward pmail-highlighted-headers nil t) |
| 2220 | coding | 2886 | (skip-chars-forward " \t") |
| 2221 | (coding-system-eol-type old-coding))) | 2887 | (let ((beg (point)) |
| 2222 | ;; Do the actual recoding. | 2888 | overlay) |
| 2223 | (encode-coding-region start end old-coding) | 2889 | (while (progn (forward-line 1) |
| 2224 | (decode-coding-region start end coding) | 2890 | (looking-at "[ \t]"))) |
| 2225 | ;; Rewrite the x-coding-system header according to | 2891 | ;; Back up over newline, then trailing spaces or tabs |
| 2226 | ;; what we did. | 2892 | (forward-char -1) |
| 2227 | (setq last-coding-system-used coding) | 2893 | (while (member (preceding-char) '(? ?\t)) |
| 2228 | (pmail-header-add-header | 2894 | (forward-char -1)) |
| 2229 | "X-Coding-System" | 2895 | (if overlays |
| 2230 | (symbol-name last-coding-system-used)) | 2896 | ;; Reuse an overlay we already have. |
| 2231 | (pmail-show-message pmail-current-message)) | 2897 | (progn |
| 2232 | (error "No X-Coding-System header found"))))))) | 2898 | (setq overlay (car overlays) |
| 2233 | 2899 | overlays (cdr overlays)) | |
| 2234 | ;; FIXME: Double-check this | 2900 | (overlay-put overlay 'face face) |
| 2901 | (move-overlay overlay beg (point))) | ||
| 2902 | ;; Make a new overlay and add it to | ||
| 2903 | ;; pmail-overlay-list. | ||
| 2904 | (setq overlay (make-overlay beg (point))) | ||
| 2905 | (overlay-put overlay 'face face) | ||
| 2906 | (setq pmail-overlay-list | ||
| 2907 | (cons overlay pmail-overlay-list)))))))))) | ||
| 2908 | |||
| 2235 | (defun pmail-auto-file () | 2909 | (defun pmail-auto-file () |
| 2236 | "Automatically move a message into a sub-folder based on criteria. | 2910 | "Automatically move a message into a sub-folder based on criteria. |
| 2237 | Called when a new message is displayed." | 2911 | Called when a new message is displayed." |
| 2238 | (if (or (member "filed" (pmail-desc-get-keywords pmail-current-message)) | 2912 | (if (or (zerop pmail-total-messages) |
| 2913 | (pmail-message-attr-p pmail-current-message "...F...") | ||
| 2239 | (not (string= (buffer-file-name) | 2914 | (not (string= (buffer-file-name) |
| 2240 | (expand-file-name pmail-file-name)))) | 2915 | (expand-file-name pmail-file-name)))) |
| 2241 | ;; Do nothing if it's already been filed. | 2916 | ;; Do nothing if the message has already been filed or if there |
| 2917 | ;; are no messages. | ||
| 2242 | nil | 2918 | nil |
| 2243 | ;; Find out some basics (common fields) | 2919 | ;; Find out some basics (common fields) |
| 2244 | (let ((from (mail-fetch-field "from")) | 2920 | (let ((from (mail-fetch-field "from")) |
| 2245 | (subj (mail-fetch-field "subject")) | 2921 | (subj (mail-fetch-field "subject")) |
| 2246 | (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) | 2922 | (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) |
| 2247 | (directives pmail-automatic-folder-directives) | 2923 | (d pmail-automatic-folder-directives) |
| 2248 | (directive-loop nil) | 2924 | (directive-loop nil) |
| 2249 | (folder nil)) | 2925 | (folder nil)) |
| 2250 | (while directives | 2926 | (while d |
| 2251 | (setq folder (car (car directives)) | 2927 | (setq folder (car (car d)) |
| 2252 | directive-loop (cdr (car directives))) | 2928 | directive-loop (cdr (car d))) |
| 2253 | (while (and (car directive-loop) | 2929 | (while (and (car directive-loop) |
| 2254 | (let ((f (cond | 2930 | (let ((f (cond |
| 2255 | ((string= (car directive-loop) "from") from) | 2931 | ((string= (car directive-loop) "from") from) |
| @@ -2264,52 +2940,46 @@ Called when a new message is displayed." | |||
| 2264 | (pmail-delete-forward) | 2940 | (pmail-delete-forward) |
| 2265 | (if (string= "/dev/null" folder) | 2941 | (if (string= "/dev/null" folder) |
| 2266 | (pmail-delete-message) | 2942 | (pmail-delete-message) |
| 2267 | (pmail-output folder 1 t) | 2943 | (pmail-output-to-pmail-file folder 1 t) |
| 2268 | (setq directives nil)))) | 2944 | (setq d nil)))) |
| 2269 | (setq directives (cdr directives)))))) | 2945 | (setq d (cdr d)))))) |
| 2270 | 2946 | ||
| 2271 | (defun pmail-next-message (n) | 2947 | (defun pmail-next-message (n) |
| 2272 | "Show following message whether deleted or not. | 2948 | "Show following message whether deleted or not. |
| 2273 | With prefix arg N, moves forward N messages, or backward if N is | 2949 | With prefix arg N, moves forward N messages, or backward if N is negative." |
| 2274 | negative." | ||
| 2275 | (interactive "p") | 2950 | (interactive "p") |
| 2276 | (with-current-buffer pmail-buffer | 2951 | (set-buffer pmail-buffer) |
| 2277 | (pmail-show-message (+ pmail-current-message n)))) | 2952 | (pmail-maybe-set-message-counters) |
| 2953 | (pmail-show-message (+ pmail-current-message n))) | ||
| 2278 | 2954 | ||
| 2279 | (defun pmail-previous-message (n) | 2955 | (defun pmail-previous-message (n) |
| 2280 | "Show previous message whether deleted or not. | 2956 | "Show previous message whether deleted or not. |
| 2281 | With prefix arg N, moves backward N messages, or forward if N is | 2957 | With prefix arg N, moves backward N messages, or forward if N is negative." |
| 2282 | negative." | ||
| 2283 | (interactive "p") | 2958 | (interactive "p") |
| 2284 | (pmail-next-message (- n))) | 2959 | (pmail-next-message (- n))) |
| 2285 | 2960 | ||
| 2286 | (defun pmail-next-undeleted-message (n) | 2961 | (defun pmail-next-undeleted-message (n) |
| 2287 | "Show following non-deleted message. | 2962 | "Show following non-deleted message. |
| 2288 | With prefix arg N, moves forward N non-deleted messages, or | 2963 | With prefix arg N, moves forward N non-deleted messages, |
| 2289 | backward if N is negative. | 2964 | or backward if N is negative. |
| 2290 | 2965 | ||
| 2291 | Returns t if a new message is being shown, nil otherwise." | 2966 | Returns t if a new message is being shown, nil otherwise." |
| 2292 | (interactive "p") | 2967 | (interactive "p") |
| 2968 | (set-buffer pmail-buffer) | ||
| 2969 | (pmail-maybe-set-message-counters) | ||
| 2293 | (let ((lastwin pmail-current-message) | 2970 | (let ((lastwin pmail-current-message) |
| 2294 | (original pmail-current-message) | ||
| 2295 | (current pmail-current-message)) | 2971 | (current pmail-current-message)) |
| 2296 | ;; Move forwards, remember the last undeleted message seen. | ||
| 2297 | (while (and (> n 0) (< current pmail-total-messages)) | 2972 | (while (and (> n 0) (< current pmail-total-messages)) |
| 2298 | (setq current (1+ current)) | 2973 | (setq current (1+ current)) |
| 2299 | (unless (pmail-desc-deleted-p current) | 2974 | (if (not (pmail-message-deleted-p current)) |
| 2300 | (setq lastwin current | 2975 | (setq lastwin current n (1- n)))) |
| 2301 | n (1- n)))) | ||
| 2302 | ;; Same thing for moving backwards | ||
| 2303 | (while (and (< n 0) (> current 1)) | 2976 | (while (and (< n 0) (> current 1)) |
| 2304 | (setq current (1- current)) | 2977 | (setq current (1- current)) |
| 2305 | (unless (pmail-desc-deleted-p current) | 2978 | (if (not (pmail-message-deleted-p current)) |
| 2306 | (setq lastwin current | 2979 | (setq lastwin current n (1+ n)))) |
| 2307 | n (1+ n)))) | 2980 | (if (/= lastwin pmail-current-message) |
| 2308 | ;; Show the message (even if no movement took place so that the | 2981 | (progn (pmail-show-message lastwin) |
| 2309 | ;; delete attribute is marked) and determine the result value. | 2982 | t) |
| 2310 | (pmail-show-message lastwin) | ||
| 2311 | (if (/= lastwin original) | ||
| 2312 | t | ||
| 2313 | (if (< n 0) | 2983 | (if (< n 0) |
| 2314 | (message "No previous nondeleted message")) | 2984 | (message "No previous nondeleted message")) |
| 2315 | (if (> n 0) | 2985 | (if (> n 0) |
| @@ -2326,44 +2996,70 @@ or forward if N is negative." | |||
| 2326 | (defun pmail-first-message () | 2996 | (defun pmail-first-message () |
| 2327 | "Show first message in file." | 2997 | "Show first message in file." |
| 2328 | (interactive) | 2998 | (interactive) |
| 2999 | (pmail-maybe-set-message-counters) | ||
| 2329 | (pmail-show-message 1)) | 3000 | (pmail-show-message 1)) |
| 2330 | 3001 | ||
| 2331 | (defun pmail-last-message () | 3002 | (defun pmail-last-message () |
| 2332 | "Show last message in file." | 3003 | "Show last message in file." |
| 2333 | (interactive) | 3004 | (interactive) |
| 3005 | (pmail-maybe-set-message-counters) | ||
| 2334 | (pmail-show-message pmail-total-messages)) | 3006 | (pmail-show-message pmail-total-messages)) |
| 2335 | 3007 | ||
| 2336 | (defun pmail-narrow-to-header (msg) | 3008 | (defun pmail-what-message () |
| 2337 | "Narrow the buffer to the headers of message number MSG." | 3009 | (let ((where (point)) |
| 2338 | (save-excursion | 3010 | (low 1) |
| 2339 | (let ((start (pmail-desc-get-start msg)) | 3011 | (high pmail-total-messages) |
| 2340 | (end (pmail-desc-get-end msg))) | 3012 | (mid (/ pmail-total-messages 2))) |
| 2341 | (widen) | 3013 | (while (> (- high low) 1) |
| 2342 | (goto-char start) | 3014 | (if (>= where (pmail-msgbeg mid)) |
| 2343 | (unless (search-forward "\n\n" end t) | 3015 | (setq low mid) |
| 2344 | (error "Invalid message format")) | 3016 | (setq high mid)) |
| 2345 | (narrow-to-region start (point))))) | 3017 | (setq mid (+ low (/ (- high low) 2)))) |
| 3018 | (if (>= where (pmail-msgbeg high)) high low))) | ||
| 2346 | 3019 | ||
| 2347 | (defun pmail-message-recipients-p (msg recipients &optional primary-only) | 3020 | (defun pmail-message-recipients-p (msg recipients &optional primary-only) |
| 2348 | (save-restriction | 3021 | (save-restriction |
| 3022 | (goto-char (pmail-msgbeg msg)) | ||
| 3023 | (search-forward "\n*** EOOH ***\n") | ||
| 3024 | (narrow-to-region (point) (progn (search-forward "\n\n") (point))) | ||
| 2349 | (or (string-match recipients (or (mail-fetch-field "To") "")) | 3025 | (or (string-match recipients (or (mail-fetch-field "To") "")) |
| 2350 | (string-match recipients (or (mail-fetch-field "From") "")) | 3026 | (string-match recipients (or (mail-fetch-field "From") "")) |
| 2351 | (if (not primary-only) | 3027 | (if (not primary-only) |
| 2352 | (string-match recipients (or (mail-fetch-field "Cc") "")))))) | 3028 | (string-match recipients (or (mail-fetch-field "Cc") "")))))) |
| 2353 | 3029 | ||
| 2354 | (defun pmail-message-regexp-p (msg regexp) | 3030 | (defun pmail-message-regexp-p (n regexp) |
| 2355 | "Return t, if for message number MSG, regexp REGEXP matches in the header." | 3031 | "Return t, if for message number N, regexp REGEXP matches in the header." |
| 2356 | (save-excursion | 3032 | (let ((beg (pmail-msgbeg n)) |
| 2357 | (save-restriction | 3033 | (end (pmail-msgend n))) |
| 2358 | (pmail-narrow-to-header msg) | 3034 | (goto-char beg) |
| 2359 | (re-search-forward regexp nil t)))) | 3035 | (forward-line 1) |
| 3036 | (save-excursion | ||
| 3037 | (save-restriction | ||
| 3038 | (if (prog1 (= (following-char) ?0) | ||
| 3039 | (forward-line 2) | ||
| 3040 | ;; If there's a Summary-line in the (otherwise empty) | ||
| 3041 | ;; header, we didn't yet get past the EOOH line. | ||
| 3042 | (when (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") | ||
| 3043 | (forward-line 1)) | ||
| 3044 | (setq beg (point)) | ||
| 3045 | (narrow-to-region (point) end)) | ||
| 3046 | (progn | ||
| 3047 | (rfc822-goto-eoh) | ||
| 3048 | (setq end (point))) | ||
| 3049 | (setq beg (point)) | ||
| 3050 | (search-forward "\n*** EOOH ***\n" end t) | ||
| 3051 | (setq end (1+ (match-beginning 0))))) | ||
| 3052 | (goto-char beg) | ||
| 3053 | (if pmail-enable-mime | ||
| 3054 | (funcall pmail-search-mime-header-function n regexp end) | ||
| 3055 | (re-search-forward regexp end t))))) | ||
| 2360 | 3056 | ||
| 2361 | (defun pmail-search-message (msg regexp) | 3057 | (defun pmail-search-message (msg regexp) |
| 2362 | "Return non-nil, if for message number MSG, regexp REGEXP matches." | 3058 | "Return non-nil, if for message number MSG, regexp REGEXP matches." |
| 2363 | (goto-char (pmail-desc-get-start msg)) | 3059 | (goto-char (pmail-msgbeg msg)) |
| 2364 | (if pmail-enable-mime | 3060 | (if pmail-enable-mime |
| 2365 | (funcall pmail-search-mime-message-function msg regexp) | 3061 | (funcall pmail-search-mime-message-function msg regexp) |
| 2366 | (re-search-forward regexp (pmail-desc-get-end msg) t))) | 3062 | (re-search-forward regexp (pmail-msgend msg) t))) |
| 2367 | 3063 | ||
| 2368 | (defvar pmail-search-last-regexp nil) | 3064 | (defvar pmail-search-last-regexp nil) |
| 2369 | (defun pmail-search (regexp &optional n) | 3065 | (defun pmail-search (regexp &optional n) |
| @@ -2394,12 +3090,13 @@ Interactively, empty argument means use same regexp used last time." | |||
| 2394 | (if (< n 0) "Reverse " "") | 3090 | (if (< n 0) "Reverse " "") |
| 2395 | regexp) | 3091 | regexp) |
| 2396 | (set-buffer pmail-buffer) | 3092 | (set-buffer pmail-buffer) |
| 3093 | (pmail-maybe-set-message-counters) | ||
| 2397 | (let ((omin (point-min)) | 3094 | (let ((omin (point-min)) |
| 2398 | (omax (point-max)) | 3095 | (omax (point-max)) |
| 2399 | (opoint (point)) | 3096 | (opoint (point)) |
| 3097 | win | ||
| 2400 | (reversep (< n 0)) | 3098 | (reversep (< n 0)) |
| 2401 | (msg pmail-current-message) | 3099 | (msg pmail-current-message)) |
| 2402 | win) | ||
| 2403 | (unwind-protect | 3100 | (unwind-protect |
| 2404 | (progn | 3101 | (progn |
| 2405 | (widen) | 3102 | (widen) |
| @@ -2462,17 +3159,20 @@ Interactively, empty argument means use same regexp used last time." | |||
| 2462 | (prefix-numeric-value current-prefix-arg)))) | 3159 | (prefix-numeric-value current-prefix-arg)))) |
| 2463 | (pmail-search regexp (- (or n 1)))) | 3160 | (pmail-search regexp (- (or n 1)))) |
| 2464 | 3161 | ||
| 2465 | ;; Show the first message which has the `unseen' attribute. | 3162 | |
| 2466 | (defun pmail-first-unseen-message () | 3163 | (defun pmail-first-unseen-message () |
| 2467 | "Return the first message which has not been seen. If all messages | 3164 | "Return the message index for the first message which has the |
| 2468 | have been seen, then return the last message." | 3165 | `unseen' attribute." |
| 3166 | (pmail-maybe-set-message-counters) | ||
| 2469 | (let ((current 1) | 3167 | (let ((current 1) |
| 2470 | found) | 3168 | found) |
| 2471 | (while (and (not found) (<= current pmail-total-messages)) | 3169 | (save-restriction |
| 2472 | (if (pmail-desc-attr-p pmail-desc-unseen-index current) | 3170 | (widen) |
| 2473 | (setq found current)) | 3171 | (while (and (not found) (<= current pmail-total-messages)) |
| 2474 | (setq current (1+ current))) | 3172 | (if (pmail-message-attr-p current "......U") |
| 2475 | (or found pmail-total-messages))) | 3173 | (setq found current)) |
| 3174 | (setq current (1+ current)))) | ||
| 3175 | found)) | ||
| 2476 | 3176 | ||
| 2477 | (defun pmail-current-subject () | 3177 | (defun pmail-current-subject () |
| 2478 | "Return the current subject. | 3178 | "Return the current subject. |
| @@ -2525,26 +3225,25 @@ If N is negative, go backwards instead." | |||
| 2525 | (save-excursion | 3225 | (save-excursion |
| 2526 | (save-restriction | 3226 | (save-restriction |
| 2527 | (widen) | 3227 | (widen) |
| 2528 | (if forward | 3228 | (while (and (/= n 0) |
| 2529 | (while (and (/= n 0) (< i pmail-total-messages)) | 3229 | (if forward |
| 2530 | (let (done) | 3230 | (< i pmail-total-messages) |
| 2531 | (while (and (not done) | 3231 | (> i 1))) |
| 2532 | (< i pmail-total-messages)) | 3232 | (let (done) |
| 2533 | (setq i (+ i 1)) | 3233 | (while (and (not done) |
| 2534 | (pmail-narrow-to-header i) | 3234 | (if forward |
| 2535 | (goto-char (point-min)) | 3235 | (< i pmail-total-messages) |
| 2536 | (setq done (re-search-forward search-regexp (point-max) t))) | 3236 | (> i 1))) |
| 2537 | (if done (setq found i))) | 3237 | (setq i (if forward (1+ i) (1- i))) |
| 2538 | (setq n (1- n))) | 3238 | (goto-char (pmail-msgbeg i)) |
| 2539 | (while (and (/= n 0) (> i 1)) | 3239 | (search-forward "\n*** EOOH ***\n") |
| 2540 | (let (done) | 3240 | (let ((beg (point)) end) |
| 2541 | (while (and (not done) (> i 1)) | 3241 | (search-forward "\n\n") |
| 2542 | (setq i (- i 1)) | 3242 | (setq end (point)) |
| 2543 | (pmail-narrow-to-header i) | 3243 | (goto-char beg) |
| 2544 | (goto-char (point-min)) | 3244 | (setq done (re-search-forward search-regexp end t)))) |
| 2545 | (setq done (re-search-forward search-regexp (point-max) t))) | 3245 | (if done (setq found i))) |
| 2546 | (if done (setq found i))) | 3246 | (setq n (if forward (1- n) (1+ n)))))) |
| 2547 | (setq n (1+ n)))))) | ||
| 2548 | (if found | 3247 | (if found |
| 2549 | (pmail-show-message found) | 3248 | (pmail-show-message found) |
| 2550 | (error "No %s message with same subject" | 3249 | (error "No %s message with same subject" |
| @@ -2559,12 +3258,17 @@ If N is negative, go forwards instead." | |||
| 2559 | 3258 | ||
| 2560 | ;;;; *** Pmail Message Deletion Commands *** | 3259 | ;;;; *** Pmail Message Deletion Commands *** |
| 2561 | 3260 | ||
| 3261 | (defun pmail-message-deleted-p (n) | ||
| 3262 | (= (aref pmail-deleted-vector n) ?D)) | ||
| 3263 | |||
| 3264 | (defun pmail-set-message-deleted-p (n state) | ||
| 3265 | (aset pmail-deleted-vector n (if state ?D ?\ ))) | ||
| 3266 | |||
| 2562 | (defun pmail-delete-message () | 3267 | (defun pmail-delete-message () |
| 2563 | "Delete this message and stay on it." | 3268 | "Delete this message and stay on it." |
| 2564 | (interactive) | 3269 | (interactive) |
| 2565 | (pmail-desc-set-attribute pmail-current-message pmail-desc-deleted-index t) | 3270 | (pmail-set-attribute pmail-deleted-attr-index t) |
| 2566 | (run-hooks 'pmail-delete-message-hook) | 3271 | (run-hooks 'pmail-delete-message-hook)) |
| 2567 | (pmail-show-message pmail-current-message)) | ||
| 2568 | 3272 | ||
| 2569 | (defun pmail-undelete-previous-message () | 3273 | (defun pmail-undelete-previous-message () |
| 2570 | "Back up to deleted message, select it, and undelete it." | 3274 | "Back up to deleted message, select it, and undelete it." |
| @@ -2572,19 +3276,19 @@ If N is negative, go forwards instead." | |||
| 2572 | (set-buffer pmail-buffer) | 3276 | (set-buffer pmail-buffer) |
| 2573 | (let ((msg pmail-current-message)) | 3277 | (let ((msg pmail-current-message)) |
| 2574 | (while (and (> msg 0) | 3278 | (while (and (> msg 0) |
| 2575 | (not (pmail-desc-attr-p pmail-desc-deleted-index msg))) | 3279 | (not (pmail-message-deleted-p msg))) |
| 2576 | (setq msg (1- msg))) | 3280 | (setq msg (1- msg))) |
| 2577 | (if (= msg 0) | 3281 | (if (= msg 0) |
| 2578 | (error "No previous deleted message") | 3282 | (error "No previous deleted message") |
| 2579 | (pmail-desc-set-attribute msg pmail-desc-deleted-index nil) | 3283 | (if (/= msg pmail-current-message) |
| 2580 | (pmail-show-message msg) | 3284 | (pmail-show-message msg)) |
| 3285 | (pmail-set-attribute pmail-deleted-attr-index nil) | ||
| 2581 | (if (pmail-summary-exists) | 3286 | (if (pmail-summary-exists) |
| 2582 | (save-excursion | 3287 | (save-excursion |
| 2583 | (set-buffer pmail-summary-buffer) | 3288 | (set-buffer pmail-summary-buffer) |
| 2584 | (pmail-summary-mark-undeleted msg))) | 3289 | (pmail-summary-mark-undeleted msg))) |
| 2585 | (pmail-maybe-display-summary)))) | 3290 | (pmail-maybe-display-summary)))) |
| 2586 | 3291 | ||
| 2587 | ;;; mbox: ready | ||
| 2588 | (defun pmail-delete-forward (&optional backward) | 3292 | (defun pmail-delete-forward (&optional backward) |
| 2589 | "Delete this message and move to next nondeleted one. | 3293 | "Delete this message and move to next nondeleted one. |
| 2590 | Deleted messages stay in the file until the \\[pmail-expunge] command is given. | 3294 | Deleted messages stay in the file until the \\[pmail-expunge] command is given. |
| @@ -2592,7 +3296,7 @@ With prefix argument, delete and move backward. | |||
| 2592 | 3296 | ||
| 2593 | Returns t if a new message is displayed after the delete, or nil otherwise." | 3297 | Returns t if a new message is displayed after the delete, or nil otherwise." |
| 2594 | (interactive "P") | 3298 | (interactive "P") |
| 2595 | (pmail-desc-set-attribute pmail-current-message pmail-desc-deleted-index t) | 3299 | (pmail-set-attribute pmail-deleted-attr-index t) |
| 2596 | (run-hooks 'pmail-delete-message-hook) | 3300 | (run-hooks 'pmail-delete-message-hook) |
| 2597 | (let ((del-msg pmail-current-message)) | 3301 | (let ((del-msg pmail-current-message)) |
| 2598 | (if (pmail-summary-exists) | 3302 | (if (pmail-summary-exists) |
| @@ -2601,39 +3305,46 @@ Returns t if a new message is displayed after the delete, or nil otherwise." | |||
| 2601 | (prog1 (pmail-next-undeleted-message (if backward -1 1)) | 3305 | (prog1 (pmail-next-undeleted-message (if backward -1 1)) |
| 2602 | (pmail-maybe-display-summary)))) | 3306 | (pmail-maybe-display-summary)))) |
| 2603 | 3307 | ||
| 2604 | ;;; mbox: ready | ||
| 2605 | (defun pmail-delete-backward () | 3308 | (defun pmail-delete-backward () |
| 2606 | "Delete this message and move to previous nondeleted one. | 3309 | "Delete this message and move to previous nondeleted one. |
| 2607 | Deleted messages stay in the file until the \\[pmail-expunge] command is given." | 3310 | Deleted messages stay in the file until the \\[pmail-expunge] command is given." |
| 2608 | (interactive) | 3311 | (interactive) |
| 2609 | (pmail-delete-forward t)) | 3312 | (pmail-delete-forward t)) |
| 2610 | 3313 | ||
| 3314 | ;; Compute the message number a given message would have after expunging. | ||
| 3315 | ;; The present number of the message is OLDNUM. | ||
| 3316 | ;; DELETEDVEC should be pmail-deleted-vector. | ||
| 3317 | ;; The value is nil for a message that would be deleted. | ||
| 3318 | (defun pmail-msg-number-after-expunge (deletedvec oldnum) | ||
| 3319 | (if (or (null oldnum) (= (aref deletedvec oldnum) ?D)) | ||
| 3320 | nil | ||
| 3321 | (let ((i 0) | ||
| 3322 | (newnum 0)) | ||
| 3323 | (while (< i oldnum) | ||
| 3324 | (if (/= (aref deletedvec i) ?D) | ||
| 3325 | (setq newnum (1+ newnum))) | ||
| 3326 | (setq i (1+ i))) | ||
| 3327 | newnum))) | ||
| 3328 | |||
| 2611 | (defun pmail-expunge-confirmed () | 3329 | (defun pmail-expunge-confirmed () |
| 2612 | "Return t if deleted message should be expunged. If necessary, ask the user. | 3330 | "Return t if deleted message should be expunged. If necessary, ask the user. |
| 2613 | See also user-option `pmail-confirm-expunge'." | 3331 | See also user-option `pmail-confirm-expunge'." |
| 2614 | (set-buffer pmail-buffer) | 3332 | (set-buffer pmail-buffer) |
| 2615 | (let ((some-deleted)) | 3333 | (or (not (stringp pmail-deleted-vector)) |
| 2616 | (dotimes (i pmail-total-messages) | 3334 | (not (string-match "D" pmail-deleted-vector)) |
| 2617 | (if (pmail-desc-deleted-p (1+ i)) | 3335 | (null pmail-confirm-expunge) |
| 2618 | (setq some-deleted t))) | 3336 | (funcall pmail-confirm-expunge |
| 2619 | (or (not some-deleted) | 3337 | "Erase deleted messages from Pmail file? "))) |
| 2620 | (null pmail-confirm-expunge) | ||
| 2621 | (funcall pmail-confirm-expunge | ||
| 2622 | "Erase deleted messages from Pmail file? ")))) | ||
| 2623 | 3338 | ||
| 2624 | (defun pmail-only-expunge (&optional dont-show) | 3339 | (defun pmail-only-expunge (&optional dont-show) |
| 2625 | "Actually erase all deleted messages in the file." | 3340 | "Actually erase all deleted messages in the file." |
| 2626 | (interactive) | 3341 | (interactive) |
| 3342 | (set-buffer pmail-buffer) | ||
| 2627 | (message "Expunging deleted messages...") | 3343 | (message "Expunging deleted messages...") |
| 2628 | ;; Discard all undo records for this buffer. | 3344 | ;; Discard all undo records for this buffer. |
| 2629 | (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) | 3345 | (or (eq buffer-undo-list t) |
| 2630 | ;; Remove the messages from the buffer and from the Pmail message | 3346 | (setq buffer-undo-list nil)) |
| 2631 | ;; descriptor vector. | 3347 | (pmail-maybe-set-message-counters) |
| 2632 | (setq pmail-expunge-counter 0) | ||
| 2633 | (pmail-desc-prune-deleted-messages 'pmail-expunge-callback) | ||
| 2634 | (setq pmail-current-message (- pmail-current-message pmail-expunge-counter)) | ||
| 2635 | ;; Deal with the summary buffer and update | ||
| 2636 | ;; the User status. | ||
| 2637 | (let* ((omax (- (buffer-size) (point-max))) | 3348 | (let* ((omax (- (buffer-size) (point-max))) |
| 2638 | (omin (- (buffer-size) (point-min))) | 3349 | (omin (- (buffer-size) (point-min))) |
| 2639 | (opoint (if (and (> pmail-current-message 0) | 3350 | (opoint (if (and (> pmail-current-message 0) |
| @@ -2642,39 +3353,86 @@ See also user-option `pmail-confirm-expunge'." | |||
| 2642 | (if pmail-enable-mime | 3353 | (if pmail-enable-mime |
| 2643 | (with-current-buffer pmail-view-buffer | 3354 | (with-current-buffer pmail-view-buffer |
| 2644 | (- (point)(point-min))) | 3355 | (- (point)(point-min))) |
| 2645 | (- (point) (point-min)))))) | 3356 | (- (point) (point-min))))) |
| 2646 | (when pmail-summary-buffer | 3357 | (messages-head (cons (aref pmail-message-vector 0) nil)) |
| 2647 | (with-current-buffer pmail-summary-buffer | 3358 | (messages-tail messages-head) |
| 2648 | (pmail-update-summary))) | 3359 | ;; Don't make any undo records for the expunging. |
| 2649 | (message "Expunging deleted messages...done") | 3360 | (buffer-undo-list t) |
| 2650 | (if (not dont-show) | 3361 | (win)) |
| 2651 | (pmail-show-message | 3362 | (unwind-protect |
| 2652 | (if (zerop pmail-current-message) 1 nil))) | 3363 | (save-excursion |
| 2653 | (if pmail-enable-mime | 3364 | (widen) |
| 2654 | (goto-char (+ (point-min) opoint)) | 3365 | (goto-char (point-min)) |
| 2655 | (goto-char (+ (point) opoint))))) | 3366 | (let ((counter 0) |
| 2656 | 3367 | (number 1) | |
| 2657 | ;;; mbox: ready | 3368 | (total pmail-total-messages) |
| 2658 | (defun pmail-expunge-callback (n) | 3369 | (new-message-number pmail-current-message) |
| 2659 | "Called after message N has been pruned to update the current Pmail | 3370 | (new-summary nil) |
| 2660 | message counter." | 3371 | (new-msgref (list (list 0))) |
| 2661 | ;; Process the various possible states to set the current message | 3372 | (pmailbuf (current-buffer)) |
| 2662 | ;; counter. | 3373 | (buffer-read-only nil) |
| 2663 | (setq pmail-total-messages (1- pmail-total-messages)) | 3374 | (messages pmail-message-vector) |
| 2664 | (if (>= pmail-current-message n) | 3375 | (deleted pmail-deleted-vector) |
| 2665 | (setq pmail-expunge-counter (1+ pmail-expunge-counter)))) | 3376 | (summary pmail-summary-vector)) |
| 2666 | 3377 | (setq pmail-total-messages nil | |
| 2667 | ;;; mbox: ready | 3378 | pmail-current-message nil |
| 3379 | pmail-message-vector nil | ||
| 3380 | pmail-deleted-vector nil | ||
| 3381 | pmail-summary-vector nil) | ||
| 3382 | |||
| 3383 | (while (<= number total) | ||
| 3384 | (if (= (aref deleted number) ?D) | ||
| 3385 | (progn | ||
| 3386 | (delete-region | ||
| 3387 | (marker-position (aref messages number)) | ||
| 3388 | (marker-position (aref messages (1+ number)))) | ||
| 3389 | (move-marker (aref messages number) nil) | ||
| 3390 | (if (> new-message-number counter) | ||
| 3391 | (setq new-message-number (1- new-message-number)))) | ||
| 3392 | (setq counter (1+ counter)) | ||
| 3393 | (setq messages-tail | ||
| 3394 | (setcdr messages-tail | ||
| 3395 | (cons (aref messages number) nil))) | ||
| 3396 | (setq new-summary | ||
| 3397 | (cons (if (= counter number) (aref summary (1- number))) | ||
| 3398 | new-summary)) | ||
| 3399 | (setq new-msgref | ||
| 3400 | (cons (aref pmail-msgref-vector number) | ||
| 3401 | new-msgref)) | ||
| 3402 | (setcar (car new-msgref) counter)) | ||
| 3403 | (if (zerop (% (setq number (1+ number)) 20)) | ||
| 3404 | (message "Expunging deleted messages...%d" number))) | ||
| 3405 | (setq messages-tail | ||
| 3406 | (setcdr messages-tail | ||
| 3407 | (cons (aref messages number) nil))) | ||
| 3408 | (setq pmail-current-message new-message-number | ||
| 3409 | pmail-total-messages counter | ||
| 3410 | pmail-message-vector (apply 'vector messages-head) | ||
| 3411 | pmail-deleted-vector (make-string (1+ counter) ?\ ) | ||
| 3412 | pmail-summary-vector (vconcat (nreverse new-summary)) | ||
| 3413 | pmail-msgref-vector (apply 'vector (nreverse new-msgref)) | ||
| 3414 | win t))) | ||
| 3415 | (message "Expunging deleted messages...done") | ||
| 3416 | (if (not win) | ||
| 3417 | (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) | ||
| 3418 | (if (not dont-show) | ||
| 3419 | (pmail-show-message | ||
| 3420 | (if (zerop pmail-current-message) 1 nil))) | ||
| 3421 | (pmail-swap-buffers-maybe) | ||
| 3422 | (if pmail-enable-mime | ||
| 3423 | (goto-char (+ (point-min) opoint)) | ||
| 3424 | (goto-char (+ (point) opoint)))))) | ||
| 3425 | |||
| 2668 | (defun pmail-expunge () | 3426 | (defun pmail-expunge () |
| 2669 | "Erase deleted messages from Pmail file and summary buffer." | 3427 | "Erase deleted messages from Pmail file and summary buffer." |
| 2670 | (interactive) | 3428 | (interactive) |
| 2671 | (when (pmail-expunge-confirmed) | 3429 | (when (pmail-expunge-confirmed) |
| 2672 | (pmail-only-expunge))) | 3430 | (pmail-only-expunge) |
| 3431 | (if (pmail-summary-exists) | ||
| 3432 | (pmail-select-summary (pmail-update-summary))))) | ||
| 2673 | 3433 | ||
| 2674 | ;;;; *** Pmail Mailing Commands *** | 3434 | ;;;; *** Pmail Mailing Commands *** |
| 2675 | 3435 | ||
| 2676 | ;;; mbox: In progress. I'm still not happy with the initial citation | ||
| 2677 | ;;; stuff. -pmr | ||
| 2678 | (defun pmail-start-mail (&optional noerase to subject in-reply-to cc | 3436 | (defun pmail-start-mail (&optional noerase to subject in-reply-to cc |
| 2679 | replybuffer sendactions same-window others) | 3437 | replybuffer sendactions same-window others) |
| 2680 | (let (yank-action) | 3438 | (let (yank-action) |
| @@ -2717,94 +3475,113 @@ Normally include CC: to all other recipients of original message; | |||
| 2717 | prefix argument means ignore them. While composing the reply, | 3475 | prefix argument means ignore them. While composing the reply, |
| 2718 | use \\[mail-yank-original] to yank the original message into it." | 3476 | use \\[mail-yank-original] to yank the original message into it." |
| 2719 | (interactive "P") | 3477 | (interactive "P") |
| 2720 | (if (= pmail-total-messages 0) | 3478 | (let (from reply-to cc subject date to message-id references |
| 2721 | (error "No messages in this file")) | 3479 | resent-to resent-cc resent-reply-to |
| 2722 | (save-excursion | 3480 | (msgnum pmail-current-message)) |
| 2723 | (save-restriction | 3481 | (save-excursion |
| 2724 | (let* ((msgnum pmail-current-message) | 3482 | (save-restriction |
| 2725 | (from (pmail-header-get-header "from")) | 3483 | (if pmail-enable-mime |
| 2726 | (reply-to (or (pmail-header-get-header "reply-to" nil t) from)) | 3484 | (narrow-to-region |
| 2727 | (cc (unless just-sender | 3485 | (goto-char (point-min)) |
| 2728 | (pmail-header-get-header "cc" nil t))) | 3486 | (if (search-forward "\n\n" nil 'move) |
| 2729 | (subject (pmail-header-get-header "subject")) | 3487 | (1+ (match-beginning 0)) |
| 2730 | (date (pmail-header-get-header "date")) | 3488 | (point))) |
| 2731 | (to (or (pmail-header-get-header "to" nil t) "")) | 3489 | (widen) |
| 2732 | (message-id (pmail-header-get-header "message-id")) | 3490 | (goto-char (pmail-msgbeg pmail-current-message)) |
| 2733 | (references (pmail-header-get-header "references" nil nil t)) | 3491 | (forward-line 1) |
| 2734 | (resent-to (pmail-header-get-header "resent-reply-to" nil t)) | 3492 | (if (= (following-char) ?0) |
| 2735 | (resent-cc (unless just-sender | 3493 | (narrow-to-region |
| 2736 | (pmail-header-get-header "resent-cc" nil t))) | 3494 | (progn (forward-line 2) |
| 2737 | (resent-reply-to (or (pmail-header-get-header "resent-to" nil t) ""))) | 3495 | (point)) |
| 2738 | ;; Merge the resent-to and resent-cc into the to and cc. | 3496 | (progn (search-forward "\n\n" (pmail-msgend pmail-current-message) |
| 2739 | (if (and resent-to (not (equal resent-to ""))) | 3497 | 'move) |
| 2740 | (if (not (equal to "")) | 3498 | (point))) |
| 2741 | (setq to (concat to ", " resent-to)) | 3499 | (narrow-to-region (point) |
| 2742 | (setq to resent-to))) | 3500 | (progn (search-forward "\n*** EOOH ***\n") |
| 2743 | (if (and resent-cc (not (equal resent-cc ""))) | 3501 | (beginning-of-line) (point))))) |
| 2744 | (if (not (equal cc "")) | 3502 | (setq from (mail-fetch-field "from") |
| 2745 | (setq cc (concat cc ", " resent-cc)) | 3503 | reply-to (or (mail-fetch-field "mail-reply-to" nil t) |
| 2746 | (setq cc resent-cc))) | 3504 | (mail-fetch-field "reply-to" nil t) |
| 2747 | ;; Add `Re: ' to subject if not there already. | 3505 | from) |
| 2748 | (and (stringp subject) | 3506 | subject (mail-fetch-field "subject") |
| 2749 | (setq subject | 3507 | date (mail-fetch-field "date") |
| 2750 | (concat pmail-reply-prefix | 3508 | message-id (mail-fetch-field "message-id") |
| 2751 | (if (let ((case-fold-search t)) | 3509 | references (mail-fetch-field "references" nil nil t) |
| 2752 | (string-match pmail-reply-regexp subject)) | 3510 | resent-reply-to (mail-fetch-field "resent-reply-to" nil t) |
| 2753 | (substring subject (match-end 0)) | 3511 | resent-cc (and (not just-sender) |
| 2754 | subject)))) | 3512 | (mail-fetch-field "resent-cc" nil t)) |
| 2755 | ;; Now setup the mail reply buffer. | 3513 | resent-to (or (mail-fetch-field "resent-to" nil t) "") |
| 2756 | (pmail-start-mail | 3514 | ;;; resent-subject (mail-fetch-field "resent-subject") |
| 2757 | nil | 3515 | ;;; resent-date (mail-fetch-field "resent-date") |
| 2758 | ;; Using mail-strip-quoted-names is undesirable with newer | 3516 | ;;; resent-message-id (mail-fetch-field "resent-message-id") |
| 2759 | ;; mailers since they can handle the names unstripped. I | 3517 | ) |
| 2760 | ;; don't know whether there are other mailers that still need | 3518 | (unless just-sender |
| 2761 | ;; the names to be stripped. | 3519 | (if (mail-fetch-field "mail-followup-to" nil t) |
| 3520 | ;; If this header field is present, use it instead of the To and CC fields. | ||
| 3521 | (setq to (mail-fetch-field "mail-followup-to" nil t)) | ||
| 3522 | (setq cc (or (mail-fetch-field "cc" nil t) "") | ||
| 3523 | to (or (mail-fetch-field "to" nil t) "")))) | ||
| 3524 | |||
| 3525 | )) | ||
| 3526 | |||
| 3527 | ;; Merge the resent-to and resent-cc into the to and cc. | ||
| 3528 | (if (and resent-to (not (equal resent-to ""))) | ||
| 3529 | (if (not (equal to "")) | ||
| 3530 | (setq to (concat to ", " resent-to)) | ||
| 3531 | (setq to resent-to))) | ||
| 3532 | (if (and resent-cc (not (equal resent-cc ""))) | ||
| 3533 | (if (not (equal cc "")) | ||
| 3534 | (setq cc (concat cc ", " resent-cc)) | ||
| 3535 | (setq cc resent-cc))) | ||
| 3536 | ;; Add `Re: ' to subject if not there already. | ||
| 3537 | (and (stringp subject) | ||
| 3538 | (setq subject | ||
| 3539 | (concat pmail-reply-prefix | ||
| 3540 | (if (let ((case-fold-search t)) | ||
| 3541 | (string-match pmail-reply-regexp subject)) | ||
| 3542 | (substring subject (match-end 0)) | ||
| 3543 | subject)))) | ||
| 3544 | (pmail-start-mail | ||
| 3545 | nil | ||
| 3546 | ;; Using mail-strip-quoted-names is undesirable with newer mailers | ||
| 3547 | ;; since they can handle the names unstripped. | ||
| 3548 | ;; I don't know whether there are other mailers that still | ||
| 3549 | ;; need the names to be stripped. | ||
| 2762 | ;;; (mail-strip-quoted-names reply-to) | 3550 | ;;; (mail-strip-quoted-names reply-to) |
| 2763 | ;; Remove unwanted names from reply-to, since Mail-Followup-To | 3551 | ;; Remove unwanted names from reply-to, since Mail-Followup-To |
| 2764 | ;; header causes all the names in it to wind up in reply-to, not | 3552 | ;; header causes all the names in it to wind up in reply-to, not |
| 2765 | ;; in cc. But if what's left is an empty list, use the original. | 3553 | ;; in cc. But if what's left is an empty list, use the original. |
| 2766 | (let* ((reply-to-list (rmail-dont-reply-to reply-to))) | 3554 | (let* ((reply-to-list (pmail-dont-reply-to reply-to))) |
| 2767 | (if (string= reply-to-list "") reply-to reply-to-list)) | 3555 | (if (string= reply-to-list "") reply-to reply-to-list)) |
| 2768 | subject | 3556 | subject |
| 2769 | (pmail-make-in-reply-to-field from date message-id) | 3557 | (pmail-make-in-reply-to-field from date message-id) |
| 2770 | (if just-sender | 3558 | (if just-sender |
| 2771 | nil | 3559 | nil |
| 2772 | ;; mail-strip-quoted-names is NOT necessary for | 3560 | ;; mail-strip-quoted-names is NOT necessary for pmail-dont-reply-to |
| 2773 | ;; rmail-dont-reply-to to do its job. | 3561 | ;; to do its job. |
| 2774 | (let* ((cc-list (rmail-dont-reply-to | 3562 | (let* ((cc-list (pmail-dont-reply-to |
| 2775 | (mail-strip-quoted-names | 3563 | (mail-strip-quoted-names |
| 2776 | (if (null cc) to (concat to ", " cc)))))) | 3564 | (if (null cc) to (concat to ", " cc)))))) |
| 2777 | (if (string= cc-list "") nil cc-list))) | 3565 | (if (string= cc-list "") nil cc-list))) |
| 2778 | pmail-view-buffer | 3566 | pmail-view-buffer |
| 2779 | (list (list 'pmail-reply-callback pmail-buffer "answered" t msgnum)) | 3567 | (list (list 'pmail-mark-message |
| 2780 | nil | 3568 | pmail-buffer |
| 2781 | (list (cons "References" (concat (mapconcat 'identity references " ") | 3569 | (with-current-buffer pmail-buffer |
| 2782 | " " message-id)))))))) | 3570 | (aref pmail-msgref-vector msgnum)) |
| 2783 | 3571 | "answered")) | |
| 2784 | (defun pmail-reply-callback (buffer attr state n) | 3572 | nil |
| 2785 | "Mail reply callback function. | 3573 | (list (cons "References" (concat (mapconcat 'identity references " ") |
| 2786 | Sets ATTR (a string) if STATE is | 3574 | " " message-id)))))) |
| 2787 | non-nil, otherwise clears it. N is the message number. | 3575 | |
| 2788 | BUFFER, possibly narrowed, contains an mbox mail message." | 3576 | (defun pmail-mark-message (buffer msgnum-list attribute) |
| 3577 | "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE. | ||
| 3578 | This is use in the send-actions for message buffers. | ||
| 3579 | MSGNUM-LIST is a list of the form (MSGNUM) | ||
| 3580 | which is an element of pmail-msgref-vector." | ||
| 2789 | (save-excursion | 3581 | (save-excursion |
| 2790 | (set-buffer buffer) | 3582 | (set-buffer buffer) |
| 2791 | (pmail-set-attribute attr state n) | 3583 | (if (car msgnum-list) |
| 2792 | (pmail-show-message))) | 3584 | (pmail-set-attribute attribute t (car msgnum-list))))) |
| 2793 | |||
| 2794 | (defun pmail-mark-message (msgnum-list attr-index) | ||
| 2795 | "Set attribute ATTRIBUTE-INDEX in the message of the car of MSGNUM-LIST. | ||
| 2796 | This is used in the send-actions for | ||
| 2797 | message buffers. MSGNUM-LIST is a list of the form (MSGNUM)." | ||
| 2798 | (save-excursion | ||
| 2799 | (let ((n (car msgnum-list))) | ||
| 2800 | (set-buffer pmail-buffer) | ||
| 2801 | (pmail-narrow-to-message n) | ||
| 2802 | (pmail-desc-set-attribute n attr-index t)))) | ||
| 2803 | |||
| 2804 | (defun pmail-narrow-to-message (n) | ||
| 2805 | "Narrow the current (pmail) buffer to bracket message N." | ||
| 2806 | (widen) | ||
| 2807 | (narrow-to-region (pmail-desc-get-start n) (pmail-desc-get-end n))) | ||
| 2808 | 3585 | ||
| 2809 | (defun pmail-make-in-reply-to-field (from date message-id) | 3586 | (defun pmail-make-in-reply-to-field (from date message-id) |
| 2810 | (cond ((not from) | 3587 | (cond ((not from) |
| @@ -2865,14 +3642,11 @@ message buffers. MSGNUM-LIST is a list of the form (MSGNUM)." | |||
| 2865 | (let ((mail-use-rfc822 t)) | 3642 | (let ((mail-use-rfc822 t)) |
| 2866 | (pmail-make-in-reply-to-field from date message-id))))) | 3643 | (pmail-make-in-reply-to-field from date message-id))))) |
| 2867 | 3644 | ||
| 2868 | ;;; mbox: ready | ||
| 2869 | (defun pmail-forward (resend) | 3645 | (defun pmail-forward (resend) |
| 2870 | "Forward the current message to another user. | 3646 | "Forward the current message to another user. |
| 2871 | With prefix argument, \"resend\" the message instead of forwarding it; | 3647 | With prefix argument, \"resend\" the message instead of forwarding it; |
| 2872 | see the documentation of `pmail-resend'." | 3648 | see the documentation of `pmail-resend'." |
| 2873 | (interactive "P") | 3649 | (interactive "P") |
| 2874 | (if (= pmail-total-messages 0) | ||
| 2875 | (error "No messages in this file")) | ||
| 2876 | (if resend | 3650 | (if resend |
| 2877 | (call-interactively 'pmail-resend) | 3651 | (call-interactively 'pmail-resend) |
| 2878 | (let ((forward-buffer pmail-buffer) | 3652 | (let ((forward-buffer pmail-buffer) |
| @@ -2890,7 +3664,7 @@ see the documentation of `pmail-resend'." | |||
| 2890 | (list (list 'pmail-mark-message | 3664 | (list (list 'pmail-mark-message |
| 2891 | forward-buffer | 3665 | forward-buffer |
| 2892 | (with-current-buffer pmail-buffer | 3666 | (with-current-buffer pmail-buffer |
| 2893 | (pmail-desc-get-start msgnum)) | 3667 | (aref pmail-msgref-vector msgnum)) |
| 2894 | "forwarded")) | 3668 | "forwarded")) |
| 2895 | ;; If only one window, use it for the mail buffer. | 3669 | ;; If only one window, use it for the mail buffer. |
| 2896 | ;; Otherwise, use another window for the mail buffer | 3670 | ;; Otherwise, use another window for the mail buffer |
| @@ -2935,8 +3709,6 @@ Optional COMMENT is a string to insert as a comment in the resent message. | |||
| 2935 | Optional ALIAS-FILE is alternate aliases file to be used by sendmail, | 3709 | Optional ALIAS-FILE is alternate aliases file to be used by sendmail, |
| 2936 | typically for purposes of moderating a list." | 3710 | typically for purposes of moderating a list." |
| 2937 | (interactive "sResend to: ") | 3711 | (interactive "sResend to: ") |
| 2938 | (if (= pmail-total-messages 0) | ||
| 2939 | (error "No messages in this file")) | ||
| 2940 | (require 'sendmail) | 3712 | (require 'sendmail) |
| 2941 | (require 'mailalias) | 3713 | (require 'mailalias) |
| 2942 | (unless (or (eq pmail-view-buffer (current-buffer)) | 3714 | (unless (or (eq pmail-view-buffer (current-buffer)) |
| @@ -3017,7 +3789,7 @@ typically for purposes of moderating a list." | |||
| 3017 | (funcall send-mail-function))) | 3789 | (funcall send-mail-function))) |
| 3018 | (kill-buffer tembuf)) | 3790 | (kill-buffer tembuf)) |
| 3019 | (with-current-buffer pmail-buffer | 3791 | (with-current-buffer pmail-buffer |
| 3020 | (pmail-set-attribute "resent" t pmail-current-message)))) | 3792 | (pmail-set-attribute pmail-resent-attr-index t pmail-current-message)))) |
| 3021 | 3793 | ||
| 3022 | (defvar mail-unsent-separator | 3794 | (defvar mail-unsent-separator |
| 3023 | (concat "^ *---+ +Unsent message follows +---+ *$\\|" | 3795 | (concat "^ *---+ +Unsent message follows +---+ *$\\|" |
| @@ -3047,16 +3819,16 @@ delimits the returned original message. | |||
| 3047 | The variable `pmail-retry-ignored-headers' is a regular expression | 3819 | The variable `pmail-retry-ignored-headers' is a regular expression |
| 3048 | specifying headers which should not be copied into the new message." | 3820 | specifying headers which should not be copied into the new message." |
| 3049 | (interactive) | 3821 | (interactive) |
| 3050 | (if (= pmail-total-messages 0) | ||
| 3051 | (error "No messages in this file")) | ||
| 3052 | (require 'mail-utils) | 3822 | (require 'mail-utils) |
| 3053 | (let ((pmail-this-buffer (current-buffer)) | 3823 | (let ((pmail-this-buffer (current-buffer)) |
| 3054 | (msgnum pmail-current-message) | 3824 | (msgnum pmail-current-message) |
| 3055 | bounce-start bounce-end bounce-indent resending | 3825 | bounce-start bounce-end bounce-indent resending |
| 3826 | ;; Fetch any content-type header in current message | ||
| 3827 | ;; Must search thru the whole unpruned header. | ||
| 3056 | (content-type | 3828 | (content-type |
| 3057 | (save-excursion | 3829 | (save-excursion |
| 3058 | (save-restriction | 3830 | (save-restriction |
| 3059 | (pmail-header-get-header "Content-Type"))))) | 3831 | (mail-fetch-field "Content-Type") )))) |
| 3060 | (save-excursion | 3832 | (save-excursion |
| 3061 | (goto-char (point-min)) | 3833 | (goto-char (point-min)) |
| 3062 | (let ((case-fold-search t)) | 3834 | (let ((case-fold-search t)) |
| @@ -3120,8 +3892,7 @@ specifying headers which should not be copied into the new message." | |||
| 3120 | (if (pmail-start-mail nil nil nil nil nil pmail-this-buffer | 3892 | (if (pmail-start-mail nil nil nil nil nil pmail-this-buffer |
| 3121 | (list (list 'pmail-mark-message | 3893 | (list (list 'pmail-mark-message |
| 3122 | pmail-this-buffer | 3894 | pmail-this-buffer |
| 3123 | (with-current-buffer pmail-buffer | 3895 | (aref pmail-msgref-vector msgnum) |
| 3124 | (pmail-desc-get-start msgnum)) | ||
| 3125 | "retried"))) | 3896 | "retried"))) |
| 3126 | ;; Insert original text as initial text of new draft message. | 3897 | ;; Insert original text as initial text of new draft message. |
| 3127 | ;; Bind inhibit-read-only since the header delimiter | 3898 | ;; Bind inhibit-read-only since the header delimiter |
| @@ -3219,18 +3990,17 @@ This has an effect only if a summary buffer exists." | |||
| 3219 | (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) | 3990 | (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) |
| 3220 | 3991 | ||
| 3221 | (defun pmail-fontify-message () | 3992 | (defun pmail-fontify-message () |
| 3222 | "Fontify the current message if it is not already fontified." | 3993 | ;; Fontify the current message if it is not already fontified. |
| 3223 | (when (text-property-any (point-min) (point-max) 'pmail-fontified nil) | 3994 | (if (text-property-any (point-min) (point-max) 'pmail-fontified nil) |
| 3224 | (let ((modified (buffer-modified-p)) | 3995 | (let ((modified (buffer-modified-p)) |
| 3225 | (buffer-undo-list t) (inhibit-read-only t) | 3996 | (buffer-undo-list t) (inhibit-read-only t) |
| 3226 | before-change-functions after-change-functions | 3997 | before-change-functions after-change-functions |
| 3227 | buffer-file-name buffer-file-truename) | 3998 | buffer-file-name buffer-file-truename) |
| 3228 | (save-excursion | 3999 | (save-excursion |
| 3229 | (save-match-data | 4000 | (save-match-data |
| 3230 | (add-text-properties (point-min) (point-max) '(pmail-fontified t)) | 4001 | (add-text-properties (point-min) (point-max) '(pmail-fontified t)) |
| 3231 | (font-lock-fontify-region (point-min) (point-max)) | 4002 | (font-lock-fontify-region (point-min) (point-max)) |
| 3232 | (and (not modified) (buffer-modified-p) | 4003 | (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))))) |
| 3233 | (set-buffer-modified-p nil))))))) | ||
| 3234 | 4004 | ||
| 3235 | ;;; Speedbar support for PMAIL files. | 4005 | ;;; Speedbar support for PMAIL files. |
| 3236 | (eval-when-compile (require 'speedbar)) | 4006 | (eval-when-compile (require 'speedbar)) |
| @@ -3408,6 +4178,7 @@ encoded string (and the same mask) will decode the string." | |||
| 3408 | (add-to-list 'desktop-buffer-mode-handlers | 4178 | (add-to-list 'desktop-buffer-mode-handlers |
| 3409 | '(pmail-mode . pmail-restore-desktop-buffer)) | 4179 | '(pmail-mode . pmail-restore-desktop-buffer)) |
| 3410 | 4180 | ||
| 4181 | |||
| 3411 | (provide 'pmail) | 4182 | (provide 'pmail) |
| 3412 | 4183 | ||
| 3413 | ;; Local Variables: | 4184 | ;; Local Variables: |