diff options
| author | Paul Reilly | 2008-09-15 20:56:53 +0000 |
|---|---|---|
| committer | Paul Reilly | 2008-09-15 20:56:53 +0000 |
| commit | 61dcccff80c057f9fc49578d4fccba958dff238b (patch) | |
| tree | c9564188e58f6f6cca9d6ec31a718dab14d281ae | |
| parent | 133fc7dcdba7fa30962bb548cbfcc6d055c304e6 (diff) | |
| download | emacs-61dcccff80c057f9fc49578d4fccba958dff238b.tar.gz emacs-61dcccff80c057f9fc49578d4fccba958dff238b.zip | |
The Rmail/mbox merge has been abandoned in favor of a restart using
the current rmail.el file. A comprehensive list of changes will be
supplied when pmail.el is morphed back into rmail.el
The current status is that pmail.el supports basic Rmail navigation
(no summary support) and shows the current message in a special
buffer using buffer-swap-text. No decoding is done yet. That is the
next step.
| -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: |