diff options
| author | Paul Reilly | 2008-10-05 14:08:21 +0000 |
|---|---|---|
| committer | Paul Reilly | 2008-10-05 14:08:21 +0000 |
| commit | fca0b79bef422e4f5a56081793e3c3716ce1478c (patch) | |
| tree | 2d37c208a48ea7de049acd39b3bc8edcceb018a6 | |
| parent | a9097c6dda772fc560a1837713efe15d8e19c9dd (diff) | |
| download | emacs-fca0b79bef422e4f5a56081793e3c3716ce1478c.tar.gz emacs-fca0b79bef422e4f5a56081793e3c3716ce1478c.zip | |
Next step in the Rmail/mbox support: getting basic summary support working.
| -rw-r--r-- | lisp/mail/pmail.el | 465 | ||||
| -rw-r--r-- | lisp/mail/pmailsum.el | 1300 |
2 files changed, 1010 insertions, 755 deletions
diff --git a/lisp/mail/pmail.el b/lisp/mail/pmail.el index 1b7c37de915..86436663013 100644 --- a/lisp/mail/pmail.el +++ b/lisp/mail/pmail.el | |||
| @@ -41,10 +41,10 @@ | |||
| 41 | (require 'mail-utils) | 41 | (require 'mail-utils) |
| 42 | (eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority | 42 | (eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority |
| 43 | 43 | ||
| 44 | (defconst pmail-attribute-header "X-BABYL-V6-ATTRIBUTES" | 44 | (defconst pmail-attribute-header "X-RMAIL-ATTRIBUTES" |
| 45 | "The header that stores the Pmail attribute data.") | 45 | "The header that stores the Pmail attribute data.") |
| 46 | 46 | ||
| 47 | (defconst pmail-keyword-header "X-BABYL-V6-KEYWORDS" | 47 | (defconst pmail-keyword-header "X-RMAIL-KEYWORDS" |
| 48 | "The header that stores the Pmail keyword data.") | 48 | "The header that stores the Pmail keyword data.") |
| 49 | 49 | ||
| 50 | ;;; Attribute indexes | 50 | ;;; Attribute indexes |
| @@ -81,9 +81,6 @@ | |||
| 81 | "An array that provides a mapping between an attribute index, | 81 | "An array that provides a mapping between an attribute index, |
| 82 | it's character representation and it's display representation.") | 82 | it's character representation and it's display representation.") |
| 83 | 83 | ||
| 84 | (defconst pmail-attribute-field-name "x-babyl-v6-attributes" | ||
| 85 | "The message header field added by Rmail to maintain status.") | ||
| 86 | |||
| 87 | (defvar deleted-head) | 84 | (defvar deleted-head) |
| 88 | (defvar font-lock-fontified) | 85 | (defvar font-lock-fontified) |
| 89 | (defvar mail-abbrev-syntax-table) | 86 | (defvar mail-abbrev-syntax-table) |
| @@ -857,20 +854,6 @@ If `pmail-display-summary' is non-nil, make a summary for this PMAIL file." | |||
| 857 | ;; Use find-buffer-visiting, not get-file-buffer, for those users | 854 | ;; Use find-buffer-visiting, not get-file-buffer, for those users |
| 858 | ;; who have find-file-visit-truename set to t. | 855 | ;; who have find-file-visit-truename set to t. |
| 859 | (existed (find-buffer-visiting file-name)) | 856 | (existed (find-buffer-visiting file-name)) |
| 860 | ;; This binding is necessary because we must decide if we | ||
| 861 | ;; need code conversion while the buffer is unibyte | ||
| 862 | ;; (i.e. enable-multibyte-characters is nil). | ||
| 863 | (pmail-enable-multibyte | ||
| 864 | (if existed | ||
| 865 | (with-current-buffer existed 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)) | ||
| 874 | run-mail-hook msg-shown) | 857 | run-mail-hook msg-shown) |
| 875 | ;; Like find-file, but in the case where a buffer existed | 858 | ;; Like find-file, but in the case where a buffer existed |
| 876 | ;; and the file was reverted, recompute the message-data. | 859 | ;; and the file was reverted, recompute the message-data. |
| @@ -955,7 +938,15 @@ If `pmail-display-summary' is non-nil, make a summary for this PMAIL file." | |||
| 955 | ((equal (point-min) (point-max)) | 938 | ((equal (point-min) (point-max)) |
| 956 | (message "Empty Pmail file.")) | 939 | (message "Empty Pmail file.")) |
| 957 | ((looking-at "From ")) | 940 | ((looking-at "From ")) |
| 958 | (t (error "Invalid mbox format mail file.")))) | 941 | (t (pmail-error-bad-format)))) |
| 942 | |||
| 943 | (defun pmail-error-bad-format (&optional msgnum) | ||
| 944 | "Report that the buffer contains a message that is not RFC2822 | ||
| 945 | compliant. | ||
| 946 | MSGNUM, if present, indicates the malformed message." | ||
| 947 | (if msgnum | ||
| 948 | (error "Message %s is not a valid RFC2822 message." msgnum) | ||
| 949 | (error "Invalid mbox format mail file."))) | ||
| 959 | 950 | ||
| 960 | (defun pmail-convert-babyl-to-mbox () | 951 | (defun pmail-convert-babyl-to-mbox () |
| 961 | "Convert the mail file from Babyl version 5 to mbox." | 952 | "Convert the mail file from Babyl version 5 to mbox." |
| @@ -1350,6 +1341,7 @@ Instead, these commands are available: | |||
| 1350 | (make-local-variable 'pmail-deleted-vector) | 1341 | (make-local-variable 'pmail-deleted-vector) |
| 1351 | (make-local-variable 'pmail-buffer) | 1342 | (make-local-variable 'pmail-buffer) |
| 1352 | (setq pmail-buffer (current-buffer)) | 1343 | (setq pmail-buffer (current-buffer)) |
| 1344 | (set-buffer-multibyte nil) | ||
| 1353 | (make-local-variable 'pmail-view-buffer) | 1345 | (make-local-variable 'pmail-view-buffer) |
| 1354 | (save-excursion | 1346 | (save-excursion |
| 1355 | (setq pmail-view-buffer (pmail-generate-viewer-buffer)) | 1347 | (setq pmail-view-buffer (pmail-generate-viewer-buffer)) |
| @@ -1639,162 +1631,152 @@ It returns t if it got any new messages." | |||
| 1639 | ;; Get rid of all undo records for this buffer. | 1631 | ;; Get rid of all undo records for this buffer. |
| 1640 | (or (eq buffer-undo-list t) | 1632 | (or (eq buffer-undo-list t) |
| 1641 | (setq buffer-undo-list nil)) | 1633 | (setq buffer-undo-list nil)) |
| 1634 | (pmail-get-new-mail-1 file-name)) | ||
| 1635 | |||
| 1636 | (defun pmail-get-new-mail-1 (file-name) | ||
| 1637 | "Continuation of 'pmail-get-new-mail. Sort of a procedural | ||
| 1638 | abstraction kind of thing to manage the code size. Return t if | ||
| 1639 | new messages are found, nil otherwise." | ||
| 1642 | (let ((all-files (if file-name (list file-name) | 1640 | (let ((all-files (if file-name (list file-name) |
| 1643 | pmail-inbox-list)) | 1641 | pmail-inbox-list)) |
| 1644 | (pmail-enable-multibyte (default-value 'enable-multibyte-characters)) | 1642 | (pmail-enable-multibyte (default-value 'enable-multibyte-characters)) |
| 1645 | found) | 1643 | found) |
| 1646 | (unwind-protect | 1644 | (unwind-protect |
| 1645 | (when all-files | ||
| 1646 | (let ((opoint (point)) | ||
| 1647 | (delete-files ()) | ||
| 1648 | ;; If buffer has not changed yet, and has not been | ||
| 1649 | ;; saved yet, don't replace the old backup file now. | ||
| 1650 | (make-backup-files (and make-backup-files (buffer-modified-p))) | ||
| 1651 | (buffer-read-only nil) | ||
| 1652 | ;; Don't make undo records for what we do in getting | ||
| 1653 | ;; mail. | ||
| 1654 | (buffer-undo-list t) | ||
| 1655 | success files file-last-names) | ||
| 1656 | ;; Pull files off all-files onto files as long as there is | ||
| 1657 | ;; no name conflict. A conflict happens when two inbox | ||
| 1658 | ;; file names have the same last component. | ||
| 1659 | (while (and all-files | ||
| 1660 | (not (member (file-name-nondirectory (car all-files)) | ||
| 1661 | file-last-names))) | ||
| 1662 | (setq files (cons (car all-files) files) | ||
| 1663 | file-last-names | ||
| 1664 | (cons (file-name-nondirectory (car all-files)) files)) | ||
| 1665 | (setq all-files (cdr all-files))) | ||
| 1666 | ;; Put them back in their original order. | ||
| 1667 | (setq files (nreverse files)) | ||
| 1668 | (goto-char (point-max)) | ||
| 1669 | (skip-chars-backward " \t\n") ; just in case of brain damage | ||
| 1670 | (delete-region (point) (point-max)) ; caused by require-final-newline | ||
| 1671 | (setq found (pmail-get-new-mail-2 file-name files delete-files)))) | ||
| 1672 | found) | ||
| 1673 | ;; Don't leave the buffer screwed up if we get a disk-full error. | ||
| 1674 | (or found (pmail-show-message-maybe)))) | ||
| 1675 | |||
| 1676 | (defun pmail-get-new-mail-2 (file-name files delete-files) | ||
| 1677 | "Return t if new messages are detected without error, nil otherwise." | ||
| 1678 | (save-excursion | ||
| 1679 | (save-restriction | ||
| 1680 | (let ((new-messages 0) | ||
| 1681 | (spam-filter-p (and (featurep 'pmail-spam-filter) pmail-use-spam-filter)) | ||
| 1682 | blurb success suffix) | ||
| 1683 | (narrow-to-region (point) (point)) | ||
| 1684 | ;; Read in the contents of the inbox files, renaming them as | ||
| 1685 | ;; necessary, and adding to the list of files to delete | ||
| 1686 | ;; eventually. | ||
| 1687 | (if file-name | ||
| 1688 | (pmail-insert-inbox-text files nil) | ||
| 1689 | (setq delete-files (pmail-insert-inbox-text files t))) | ||
| 1690 | ;; Scan the new text and convert each message to | ||
| 1691 | ;; Pmail/mbox format. | ||
| 1692 | (goto-char (point-min)) | ||
| 1693 | (unwind-protect | ||
| 1694 | (setq new-messages (pmail-add-mbox-headers) | ||
| 1695 | success t) | ||
| 1696 | ;; Try to delete the garbage just inserted. | ||
| 1697 | (or success (delete-region (point-min) (point-max))) | ||
| 1698 | ;; If we could not convert the file's inboxes, rename the | ||
| 1699 | ;; files we tried to read so we won't over and over again. | ||
| 1700 | (if (and (not file-name) (not success)) | ||
| 1701 | (let ((delfiles delete-files) | ||
| 1702 | (count 0)) | ||
| 1703 | (while delfiles | ||
| 1704 | (while (file-exists-p (format "PMAILOSE.%d" count)) | ||
| 1705 | (setq count (1+ count))) | ||
| 1706 | (rename-file (car delfiles) (format "PMAILOSE.%d" count)) | ||
| 1707 | (setq delfiles (cdr delfiles)))))) | ||
| 1708 | ;; Determine if there are messages. | ||
| 1709 | (unless (zerop new-messages) | ||
| 1710 | ;; There are. Process them. | ||
| 1711 | (goto-char (point-min)) | ||
| 1712 | (pmail-count-new-messages) | ||
| 1713 | (run-hooks 'pmail-get-new-mail-hook) | ||
| 1714 | (save-buffer)) | ||
| 1715 | ;; Delete the old files, now that the Pmail file is saved. | ||
| 1716 | (while delete-files | ||
| 1717 | (condition-case () | ||
| 1718 | ;; First, try deleting. | ||
| 1719 | (condition-case () | ||
| 1720 | (delete-file (car delete-files)) | ||
| 1721 | (file-error | ||
| 1722 | ;; If we can't delete it, truncate it. | ||
| 1723 | (write-region (point) (point) (car delete-files)))) | ||
| 1724 | (file-error nil)) | ||
| 1725 | (setq delete-files (cdr delete-files))) | ||
| 1726 | (if (zerop new-messages) | ||
| 1727 | (when (or file-name pmail-inbox-list) | ||
| 1728 | (message "(No new mail has arrived)")) | ||
| 1729 | ;; Generate the spam message. | ||
| 1730 | (setq blurb (if spam-filter-p | ||
| 1731 | (pmail-get-new-mail-filter-spam new-messages) | ||
| 1732 | ""))) | ||
| 1733 | (if (pmail-summary-exists) | ||
| 1734 | (pmail-select-summary (pmail-update-summary))) | ||
| 1735 | (setq suffix (if (= 1 new-messages) "" "s")) | ||
| 1736 | (message "%d new message%s read%s" new-messages suffix blurb) | ||
| 1737 | (when spam-filter-p | ||
| 1738 | (if rsf-beep (beep t)) | ||
| 1739 | (sleep-for rsf-sleep-after-message)) | ||
| 1740 | |||
| 1741 | ;; Move to the first new message | ||
| 1742 | ;; unless we have other unseen messages before it. | ||
| 1743 | (pmail-show-message-maybe (pmail-first-unseen-message)) | ||
| 1744 | (run-hooks 'pmail-after-get-new-mail-hook) | ||
| 1745 | (> new-messages 0))))) | ||
| 1746 | |||
| 1747 | (defun pmail-get-new-mail-filter-spam (new-message-count) | ||
| 1748 | "Process new messages for spam." | ||
| 1749 | (let* ((old-messages (- pmail-total-messages new-message-count)) | ||
| 1750 | (rsf-number-of-spam 0) | ||
| 1751 | (rsf-scanned-message-number (1+ old-messages)) | ||
| 1752 | ;; save deletion flags of old messages: vector starts at zero | ||
| 1753 | ;; (is one longer that no of messages), therefore take 1+ | ||
| 1754 | ;; old-messages | ||
| 1755 | (save-deleted (substring pmail-deleted-vector 0 (1+ old-messages))) | ||
| 1756 | blurb) | ||
| 1757 | ;; set all messages to undeleted | ||
| 1758 | (setq pmail-deleted-vector (make-string (1+ pmail-total-messages) ?\ )) | ||
| 1759 | (while (<= rsf-scanned-message-number pmail-total-messages) | ||
| 1760 | (progn | ||
| 1761 | (if (not (pmail-spam-filter rsf-scanned-message-number)) | ||
| 1762 | (progn (setq rsf-number-of-spam (1+ rsf-number-of-spam)))) | ||
| 1763 | (setq rsf-scanned-message-number (1+ rsf-scanned-message-number)))) | ||
| 1764 | (if (> rsf-number-of-spam 0) | ||
| 1647 | (progn | 1765 | (progn |
| 1648 | (while all-files | 1766 | (when (pmail-expunge-confirmed) |
| 1649 | (let ((opoint (point)) | 1767 | (pmail-only-expunge t)))) |
| 1650 | (new-messages 0) | 1768 | (setq pmail-deleted-vector |
| 1651 | (rsf-number-of-spam 0) | 1769 | (concat save-deleted |
| 1652 | (delete-files ()) | 1770 | (make-string (- pmail-total-messages old-messages) ?\ ))) |
| 1653 | ;; If buffer has not changed yet, and has not been saved yet, | 1771 | ;; Generate a return value message based on the number of spam |
| 1654 | ;; don't replace the old backup file now. | 1772 | ;; messages found. |
| 1655 | (make-backup-files (and make-backup-files (buffer-modified-p))) | 1773 | (cond |
| 1656 | (buffer-read-only nil) | 1774 | ((zerop rsf-number-of-spam) "") |
| 1657 | ;; Don't make undo records for what we do in getting mail. | 1775 | ((= 1 new-message-count) ", and appears to be spam") |
| 1658 | (buffer-undo-list t) | 1776 | ((= rsf-number-of-spam new-message-count) ", and all appear to be spam") |
| 1659 | success | 1777 | ((> rsf-number-of-spam 1) |
| 1660 | ;; Files to insert this time around. | 1778 | (format ", and %d appear to be spam" rsf-number-of-spam)) |
| 1661 | files | 1779 | (t ", and 1 appears to be spam")))) |
| 1662 | ;; Last names of those files. | ||
| 1663 | file-last-names) | ||
| 1664 | ;; Pull files off all-files onto files | ||
| 1665 | ;; as long as there is no name conflict. | ||
| 1666 | ;; A conflict happens when two inbox file names | ||
| 1667 | ;; have the same last component. | ||
| 1668 | (while (and all-files | ||
| 1669 | (not (member (file-name-nondirectory (car all-files)) | ||
| 1670 | file-last-names))) | ||
| 1671 | (setq files (cons (car all-files) files) | ||
| 1672 | file-last-names | ||
| 1673 | (cons (file-name-nondirectory (car all-files)) files)) | ||
| 1674 | (setq all-files (cdr all-files))) | ||
| 1675 | ;; Put them back in their original order. | ||
| 1676 | (setq files (nreverse files)) | ||
| 1677 | |||
| 1678 | (goto-char (point-max)) | ||
| 1679 | (skip-chars-backward " \t\n") ; just in case of brain damage | ||
| 1680 | (delete-region (point) (point-max)) ; caused by require-final-newline | ||
| 1681 | (save-excursion | ||
| 1682 | (save-restriction | ||
| 1683 | (narrow-to-region (point) (point)) | ||
| 1684 | ;; Read in the contents of the inbox files, | ||
| 1685 | ;; renaming them as necessary, | ||
| 1686 | ;; and adding to the list of files to delete eventually. | ||
| 1687 | (if file-name | ||
| 1688 | (pmail-insert-inbox-text files nil) | ||
| 1689 | (setq delete-files (pmail-insert-inbox-text files t))) | ||
| 1690 | ;; Scan the new text and convert each message to mbox format. | ||
| 1691 | (goto-char (point-min)) | ||
| 1692 | (unwind-protect | ||
| 1693 | (save-excursion | ||
| 1694 | (setq new-messages (pmail-add-babyl-headers) | ||
| 1695 | success t)) | ||
| 1696 | ;; Try to delete the garbage just inserted. | ||
| 1697 | (or success (delete-region (point-min) (point-max))) | ||
| 1698 | ;; If we could not convert the file's inboxes, | ||
| 1699 | ;; rename the files we tried to read | ||
| 1700 | ;; so we won't over and over again. | ||
| 1701 | (if (and (not file-name) (not success)) | ||
| 1702 | (let ((delfiles delete-files) | ||
| 1703 | (count 0)) | ||
| 1704 | (while delfiles | ||
| 1705 | (while (file-exists-p (format "PMAILOSE.%d" count)) | ||
| 1706 | (setq count (1+ count))) | ||
| 1707 | (rename-file (car delfiles) | ||
| 1708 | (format "PMAILOSE.%d" count)) | ||
| 1709 | (setq delfiles (cdr delfiles)))))) | ||
| 1710 | (or (zerop new-messages) | ||
| 1711 | (let (success) | ||
| 1712 | (goto-char (point-min)) | ||
| 1713 | (pmail-count-new-messages) | ||
| 1714 | (run-hooks 'pmail-get-new-mail-hook) | ||
| 1715 | (save-buffer))) | ||
| 1716 | ;; Delete the old files, now that babyl file is saved. | ||
| 1717 | (while delete-files | ||
| 1718 | (condition-case () | ||
| 1719 | ;; First, try deleting. | ||
| 1720 | (condition-case () | ||
| 1721 | (delete-file (car delete-files)) | ||
| 1722 | (file-error | ||
| 1723 | ;; If we can't delete it, truncate it. | ||
| 1724 | (write-region (point) (point) (car delete-files)))) | ||
| 1725 | (file-error nil)) | ||
| 1726 | (setq delete-files (cdr delete-files))))) | ||
| 1727 | (if (= new-messages 0) | ||
| 1728 | (progn (goto-char opoint) | ||
| 1729 | (if (or file-name pmail-inbox-list) | ||
| 1730 | (message "(No new mail has arrived)"))) | ||
| 1731 | ;; check new messages to see if any of them is spam: | ||
| 1732 | (if (and (featurep 'pmail-spam-filter) | ||
| 1733 | pmail-use-spam-filter) | ||
| 1734 | (let* | ||
| 1735 | ((old-messages (- pmail-total-messages new-messages)) | ||
| 1736 | (rsf-scanned-message-number (1+ old-messages)) | ||
| 1737 | ;; save deletion flags of old messages: vector starts | ||
| 1738 | ;; at zero (is one longer that no of messages), | ||
| 1739 | ;; therefore take 1+ old-messages | ||
| 1740 | (save-deleted | ||
| 1741 | (substring pmail-deleted-vector 0 (1+ | ||
| 1742 | old-messages)))) | ||
| 1743 | ;; set all messages to undeleted | ||
| 1744 | (setq pmail-deleted-vector | ||
| 1745 | (make-string (1+ pmail-total-messages) ?\ )) | ||
| 1746 | (while (<= rsf-scanned-message-number | ||
| 1747 | pmail-total-messages) | ||
| 1748 | (progn | ||
| 1749 | (if (not (pmail-spam-filter rsf-scanned-message-number)) | ||
| 1750 | (progn (setq rsf-number-of-spam (1+ rsf-number-of-spam))) | ||
| 1751 | ) | ||
| 1752 | (setq rsf-scanned-message-number (1+ rsf-scanned-message-number)) | ||
| 1753 | )) | ||
| 1754 | (if (> rsf-number-of-spam 0) | ||
| 1755 | (progn | ||
| 1756 | (when (pmail-expunge-confirmed) | ||
| 1757 | (pmail-only-expunge t)) | ||
| 1758 | )) | ||
| 1759 | (setq pmail-deleted-vector | ||
| 1760 | (concat | ||
| 1761 | save-deleted | ||
| 1762 | (make-string (- pmail-total-messages old-messages) | ||
| 1763 | ?\ ))) | ||
| 1764 | )) | ||
| 1765 | (if (pmail-summary-exists) | ||
| 1766 | (pmail-select-summary | ||
| 1767 | (pmail-update-summary))) | ||
| 1768 | (message "%d new message%s read%s" | ||
| 1769 | new-messages (if (= 1 new-messages) "" "s") | ||
| 1770 | ;; print out a message on number of spam messages found: | ||
| 1771 | (if (and (featurep 'pmail-spam-filter) | ||
| 1772 | pmail-use-spam-filter | ||
| 1773 | (> rsf-number-of-spam 0)) | ||
| 1774 | (cond ((= 1 new-messages) | ||
| 1775 | ", and appears to be spam") | ||
| 1776 | ((= rsf-number-of-spam new-messages) | ||
| 1777 | ", and all appear to be spam") | ||
| 1778 | ((> rsf-number-of-spam 1) | ||
| 1779 | (format ", and %d appear to be spam" | ||
| 1780 | rsf-number-of-spam)) | ||
| 1781 | (t | ||
| 1782 | ", and 1 appears to be spam")) | ||
| 1783 | "")) | ||
| 1784 | (when (and (featurep 'pmail-spam-filter) | ||
| 1785 | pmail-use-spam-filter | ||
| 1786 | (> rsf-number-of-spam 0)) | ||
| 1787 | (if rsf-beep (beep t)) | ||
| 1788 | (sleep-for rsf-sleep-after-message)) | ||
| 1789 | |||
| 1790 | ;; Move to the first new message | ||
| 1791 | ;; unless we have other unseen messages before it. | ||
| 1792 | (pmail-show-message-maybe (pmail-first-unseen-message)) | ||
| 1793 | (run-hooks 'pmail-after-get-new-mail-hook) | ||
| 1794 | (setq found t)))) | ||
| 1795 | found) | ||
| 1796 | ;; Don't leave the buffer screwed up if we get a disk-full error. | ||
| 1797 | (or found (pmail-show-message-maybe))))) | ||
| 1798 | 1780 | ||
| 1799 | (defun pmail-parse-url (file) | 1781 | (defun pmail-parse-url (file) |
| 1800 | "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD) | 1782 | "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD) |
| @@ -2004,36 +1986,47 @@ is non-nil if the user has supplied the password interactively. | |||
| 2004 | (setq last-coding-system-used | 1986 | (setq last-coding-system-used |
| 2005 | (coding-system-change-eol-conversion coding 0)))) | 1987 | (coding-system-change-eol-conversion coding 0)))) |
| 2006 | 1988 | ||
| 2007 | (defun pmail-add-babyl-headers () | 1989 | (defun pmail-add-header (name value) |
| 1990 | "Add a message header named NAME with value VALUE. | ||
| 1991 | The current buffer is narrowed to the headers for some | ||
| 1992 | message (including the blank line separator)." | ||
| 1993 | ;; Position point at the end of the headers but before the blank | ||
| 1994 | ;; line separating the headers from the body. | ||
| 1995 | (goto-char (point-max)) | ||
| 1996 | (forward-char -1) | ||
| 1997 | (insert name ": " value "\n")) | ||
| 1998 | |||
| 1999 | (defun pmail-add-mbox-headers () | ||
| 2008 | "Validate the RFC2822 format for the new messages. Point, at | 2000 | "Validate the RFC2822 format for the new messages. Point, at |
| 2009 | entry should be looking at the first new message. An error will | 2001 | entry should be looking at the first new message. An error will |
| 2010 | be thrown if the new messages are not RCC2822 compliant. Lastly, | 2002 | be thrown if the new messages are not RCC2822 compliant. Lastly, |
| 2011 | unless one already exists, add an Rmail attribute header to the | 2003 | unless one already exists, add an Rmail attribute header to the |
| 2012 | new messages in the region " | 2004 | new messages in the region. Return the number of new messages." |
| 2013 | (let ((count 0) | 2005 | (save-excursion |
| 2014 | (start (point)) | 2006 | (let ((count 0) |
| 2015 | limit) | 2007 | (start (point)) |
| 2016 | ;; Detect an empty inbox file. | 2008 | (value "------U") |
| 2017 | (unless (= start (point-max)) | 2009 | limit) |
| 2018 | ;; Scan the new messages to establish a count and to insure that | 2010 | ;; Detect an empty inbox file. |
| 2019 | ;; an attribute header is present. | 2011 | (unless (= start (point-max)) |
| 2020 | (while (looking-at "From ") | 2012 | ;; Scan the new messages to establish a count and to insure that |
| 2021 | ;; Determine if a new attribute header needs to be added to | 2013 | ;; an attribute header is present. |
| 2022 | ;; the message. | 2014 | (while (looking-at "From ") |
| 2023 | (if (search-forward "\n\n" nil t) | 2015 | ;; Determine if a new attribute header needs to be added to |
| 2024 | (progn | 2016 | ;; the message. |
| 2025 | (setq count (1+ count)) | 2017 | (if (search-forward "\n\n" nil t) |
| 2026 | (forward-char -1) | 2018 | (progn |
| 2027 | (narrow-to-region start (point)) | 2019 | (setq count (1+ count)) |
| 2028 | (unless (mail-fetch-field pmail-attribute-header) | 2020 | (narrow-to-region start (point)) |
| 2029 | (insert pmail-attribute-header ": ------U\n")) | 2021 | (unless (mail-fetch-field pmail-attribute-header) |
| 2030 | (widen)) | 2022 | (pmail-add-header pmail-attribute-header value)) |
| 2031 | (error "Invalid mbox format detected in inbox file")) | 2023 | (widen)) |
| 2032 | ;; Move to the next message. | 2024 | (pmail-error-bad-format)) |
| 2033 | (if (search-forward "\n\nFrom " nil 'move) | 2025 | ;; Move to the next message. |
| 2034 | (forward-char -5)) | 2026 | (if (search-forward "\n\nFrom " nil 'move) |
| 2035 | (setq start (point)))) | 2027 | (forward-char -5)) |
| 2036 | count)) | 2028 | (setq start (point)))) |
| 2029 | count))) | ||
| 2037 | 2030 | ||
| 2038 | ;; the pmail-break-forwarded-messages feature is not implemented | 2031 | ;; the pmail-break-forwarded-messages feature is not implemented |
| 2039 | (defun pmail-convert-to-babyl-format () | 2032 | (defun pmail-convert-to-babyl-format () |
| @@ -2407,7 +2400,7 @@ copy all header fields whose names do not match | |||
| 2407 | (narrow-to-region beg (point)) | 2400 | (narrow-to-region beg (point)) |
| 2408 | (goto-char (point-min)) | 2401 | (goto-char (point-min)) |
| 2409 | (unless (re-search-forward header-start-regexp nil t) | 2402 | (unless (re-search-forward header-start-regexp nil t) |
| 2410 | (error "Invalid mbox format; no header follows the From message separator.")) | 2403 | (pmail-error-bad-format)) |
| 2411 | (forward-char -1) | 2404 | (forward-char -1) |
| 2412 | (cond | 2405 | (cond |
| 2413 | ;; Handle the case where all headers should be copied. | 2406 | ;; Handle the case where all headers should be copied. |
| @@ -2478,13 +2471,13 @@ current mail message will be used otherwise." | |||
| 2478 | (progn | 2471 | (progn |
| 2479 | (narrow-to-region beg end) | 2472 | (narrow-to-region beg end) |
| 2480 | (mail-fetch-field name)) | 2473 | (mail-fetch-field name)) |
| 2481 | (error "Invalid mbox format encountered."))))))) | 2474 | (pmail-error-bad-format msg))))))) |
| 2482 | 2475 | ||
| 2483 | (defun pmail-get-attr-names (&optional msg) | 2476 | (defun pmail-get-attr-names (&optional msg) |
| 2484 | "Return the message attributes in a comma separated string. | 2477 | "Return the message attributes in a comma separated string. |
| 2485 | MSG, if set identifies the message number to use. The current | 2478 | MSG, if set identifies the message number to use. The current |
| 2486 | mail message will be used otherwise." | 2479 | mail message will be used otherwise." |
| 2487 | (let ((value (pmail-get-header pmail-attribute-field-name msg)) | 2480 | (let ((value (pmail-get-header pmail-attribute-header msg)) |
| 2488 | result temp) | 2481 | result temp) |
| 2489 | (dotimes (index (length value)) | 2482 | (dotimes (index (length value)) |
| 2490 | (setq temp (and (not (= ?- (aref value index))) | 2483 | (setq temp (and (not (= ?- (aref value index))) |
| @@ -2530,7 +2523,7 @@ for the current message." | |||
| 2530 | 2523 | ||
| 2531 | (defun pmail-get-attr-value (attr state) | 2524 | (defun pmail-get-attr-value (attr state) |
| 2532 | "Return the character value for ATTR. | 2525 | "Return the character value for ATTR. |
| 2533 | ATTR is a (numberic) index, an offset into the mbox attribute | 2526 | ATTR is a (numeric) index, an offset into the mbox attribute |
| 2534 | header value. STATE is one of nil, t, or a character value." | 2527 | header value. STATE is one of nil, t, or a character value." |
| 2535 | (cond | 2528 | (cond |
| 2536 | ((numberp state) state) | 2529 | ((numberp state) state) |
| @@ -2588,9 +2581,49 @@ match for the regexp ATTRS." | |||
| 2588 | (and limit | 2581 | (and limit |
| 2589 | (search-forward (concat pmail-attribute-header ": ") limit t) | 2582 | (search-forward (concat pmail-attribute-header ": ") limit t) |
| 2590 | (looking-at attrs)))))) | 2583 | (looking-at attrs)))))) |
| 2584 | |||
| 2585 | (defun pmail-message-unseen-p (msgnum) | ||
| 2586 | "Test the unseen attribute for message MSGNUM. | ||
| 2587 | Return non-nil if the unseen attribute is set, nil otherwise." | ||
| 2588 | (pmail-message-attr-p msgnum "......U")) | ||
| 2589 | |||
| 2591 | 2590 | ||
| 2592 | ;;;; *** Pmail Message Selection And Support *** | 2591 | ;;;; *** Pmail Message Selection And Support *** |
| 2593 | 2592 | ||
| 2593 | ;; (defun pmail-get-collection-buffer () | ||
| 2594 | ;; "Return the buffer containing the mbox formatted messages." | ||
| 2595 | ;; (if (eq major-mode 'pmail-mode) | ||
| 2596 | ;; (if pmail-buffers-swapped-p | ||
| 2597 | ;; pmail-view-buffer | ||
| 2598 | ;; pmail-buffer) | ||
| 2599 | ;; (error "The current buffer must be in Pmail mode."))) | ||
| 2600 | |||
| 2601 | (defun pmail-use-collection-buffer () | ||
| 2602 | "Insure that the Pmail buffer contains the message collection. | ||
| 2603 | Return the current message number if the Pmail buffer is in a | ||
| 2604 | swapped state, i.e. it currently contains a single decoded | ||
| 2605 | message rather than an entire message collection, nil otherwise." | ||
| 2606 | (let (result) | ||
| 2607 | (when pmail-buffers-swapped-p | ||
| 2608 | (buffer-swap-text pmail-view-buffer) | ||
| 2609 | (setq pmail-buffers-swapped-p nil | ||
| 2610 | result pmail-current-message)) | ||
| 2611 | result)) | ||
| 2612 | |||
| 2613 | (defun pmail-use-viewer-buffer (&optional msgnum) | ||
| 2614 | "Insure that the Pmail buffer contains the current message. | ||
| 2615 | If message MSGNUM is non-nil make it the current message and | ||
| 2616 | display it. Return nil." | ||
| 2617 | (let (result) | ||
| 2618 | (cond | ||
| 2619 | ((not pmail-buffers-swapped-p) | ||
| 2620 | (let ((message (or msgnum pmail-current-message))) | ||
| 2621 | (pmail-show-message message))) | ||
| 2622 | ((and msgnum (/= msgnum pmail-current-message)) | ||
| 2623 | (pmail-show-message msgnum)) | ||
| 2624 | (t)) | ||
| 2625 | result)) | ||
| 2626 | |||
| 2594 | (defun pmail-msgend (n) | 2627 | (defun pmail-msgend (n) |
| 2595 | (marker-position (aref pmail-message-vector (1+ n)))) | 2628 | (marker-position (aref pmail-message-vector (1+ n)))) |
| 2596 | 2629 | ||
| @@ -2722,7 +2755,7 @@ the message. Point is at the beginning of the message." | |||
| 2722 | ;; addition to inlining. | 2755 | ;; addition to inlining. |
| 2723 | (save-excursion | 2756 | (save-excursion |
| 2724 | (setq deleted-head | 2757 | (setq deleted-head |
| 2725 | (cons (if (and (search-forward "X-BABYL-V6-ATTRIBUTES: " message-end t) | 2758 | (cons (if (and (search-forward (concat pmail-attribute-header ": ") message-end t) |
| 2726 | (looking-at "?D")) | 2759 | (looking-at "?D")) |
| 2727 | ?D | 2760 | ?D |
| 2728 | ?\ ) deleted-head)))) | 2761 | ?\ ) deleted-head)))) |
| @@ -2820,21 +2853,21 @@ If summary buffer is currently displayed, update current message there also." | |||
| 2820 | (with-current-buffer pmail-view-buffer | 2853 | (with-current-buffer pmail-view-buffer |
| 2821 | (erase-buffer) | 2854 | (erase-buffer) |
| 2822 | (setq blurb "No mail."))) | 2855 | (setq blurb "No mail."))) |
| 2823 | (setq blurb (pmail-show-message n))) | 2856 | (setq blurb (pmail-show-message n)) |
| 2824 | (when mail-mailing-lists | 2857 | (when mail-mailing-lists |
| 2825 | (pmail-unknown-mail-followup-to)) | 2858 | (pmail-unknown-mail-followup-to)) |
| 2826 | (if transient-mark-mode (deactivate-mark)) | 2859 | (if transient-mark-mode (deactivate-mark)) |
| 2827 | ;; If there is a summary buffer, try to move to this message | 2860 | ;; If there is a summary buffer, try to move to this message |
| 2828 | ;; in that buffer. But don't complain if this message | 2861 | ;; in that buffer. But don't complain if this message |
| 2829 | ;; is not mentioned in the summary. | 2862 | ;; is not mentioned in the summary. |
| 2830 | ;; Don't do this at all if we were called on behalf | 2863 | ;; Don't do this at all if we were called on behalf |
| 2831 | ;; of cursor motion in the summary buffer. | 2864 | ;; of cursor motion in the summary buffer. |
| 2832 | (and (pmail-summary-exists) (not no-summary) | 2865 | (and (pmail-summary-exists) (not no-summary) |
| 2833 | (let ((curr-msg pmail-current-message)) | 2866 | (let ((curr-msg pmail-current-message)) |
| 2834 | (pmail-select-summary | 2867 | (pmail-select-summary |
| 2835 | (pmail-summary-goto-msg curr-msg t t)))) | 2868 | (pmail-summary-goto-msg curr-msg t t)))) |
| 2836 | (with-current-buffer pmail-buffer | 2869 | (with-current-buffer pmail-buffer |
| 2837 | (pmail-auto-file)) | 2870 | (pmail-auto-file))) |
| 2838 | (if blurb | 2871 | (if blurb |
| 2839 | (message blurb)))) | 2872 | (message blurb)))) |
| 2840 | 2873 | ||
diff --git a/lisp/mail/pmailsum.el b/lisp/mail/pmailsum.el index 505a32d91fc..0fed20e2e5c 100644 --- a/lisp/mail/pmailsum.el +++ b/lisp/mail/pmailsum.el | |||
| @@ -23,19 +23,10 @@ | |||
| 23 | 23 | ||
| 24 | ;;; Commentary: | 24 | ;;; Commentary: |
| 25 | 25 | ||
| 26 | ;; All commands run from the summary buffer update the buffer local | ||
| 27 | ;; variable `pmail-current-message'. As part of the post command | ||
| 28 | ;; processing point is moved to the beginning of the line describing | ||
| 29 | ;; the current message. | ||
| 30 | |||
| 31 | ;;; History: | ||
| 32 | |||
| 33 | ;; Extended by Bob Weiner of Motorola | 26 | ;; Extended by Bob Weiner of Motorola |
| 34 | ;; Provided all commands from pmail-mode in pmail-summary-mode and made key | 27 | ;; Provided all commands from pmail-mode in pmail-summary-mode and made key |
| 35 | ;; bindings in both modes wholly compatible. | 28 | ;; bindings in both modes wholly compatible. |
| 36 | 29 | ||
| 37 | ;; Overhauled by Paul Reilly to support mbox format. | ||
| 38 | |||
| 39 | ;;; Code: | 30 | ;;; Code: |
| 40 | 31 | ||
| 41 | (defvar msgnum) | 32 | (defvar msgnum) |
| @@ -51,175 +42,28 @@ | |||
| 51 | 42 | ||
| 52 | ;;;###autoload | 43 | ;;;###autoload |
| 53 | (defcustom pmail-summary-line-count-flag t | 44 | (defcustom pmail-summary-line-count-flag t |
| 54 | "*Non-nil if Pmail summary should show the number of lines in each message." | 45 | "*Non-nil means Pmail summary should show the number of lines in each message." |
| 55 | :type 'boolean | 46 | :type 'boolean |
| 56 | :group 'pmail-summary) | 47 | :group 'pmail-summary) |
| 57 | 48 | ||
| 49 | (defconst pmail-summary-header "X-BABYL-V6-SUMMARY" | ||
| 50 | "The header that stores the Pmail summary line.") | ||
| 51 | |||
| 58 | (defvar pmail-summary-font-lock-keywords | 52 | (defvar pmail-summary-font-lock-keywords |
| 59 | '(("^.....D.*" . font-lock-string-face) ; Deleted. | 53 | '(("^.....D.*" . font-lock-string-face) ; Deleted. |
| 60 | ("^.....-.*" . font-lock-type-face) ; Unread. | 54 | ("^.....-.*" . font-lock-type-face) ; Unread. |
| 61 | ;; Neither of the below will be highlighted if either of the above are: | 55 | ;; Neither of the below will be highlighted if either of the above are: |
| 62 | ("^.....[^D-]....\\(......\\)" 1 font-lock-keyword-face) ; Date. | 56 | ("^.....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date. |
| 63 | ("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels. | 57 | ("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels. |
| 64 | "Additional expressions to highlight in Pmail Summary mode.") | 58 | "Additional expressions to highlight in Pmail Summary mode.") |
| 65 | 59 | ||
| 66 | (defvar pmail-summary-redo nil | 60 | (defvar pmail-summary-redo |
| 67 | "Private storage for Pmail summary history.") | 61 | "(FUNCTION . ARGS) to regenerate this Pmail summary buffer.") |
| 68 | 62 | ||
| 69 | (defvar pmail-summary-overlay nil | 63 | (defvar pmail-summary-overlay nil) |
| 70 | "Private storage for an Pmail summary overlay cache") | ||
| 71 | (put 'pmail-summary-overlay 'permanent-local t) | 64 | (put 'pmail-summary-overlay 'permanent-local t) |
| 72 | 65 | ||
| 73 | (defvar pmail-summary-mode-map | 66 | (defvar pmail-summary-mode-map nil) |
| 74 | (let ((map (make-keymap))) | ||
| 75 | (suppress-keymap map) | ||
| 76 | (define-key map [mouse-2] 'pmail-summary-mouse-goto-message) | ||
| 77 | (define-key map "a" 'pmail-summary-add-label) | ||
| 78 | (define-key map "b" 'pmail-summary-bury) | ||
| 79 | (define-key map "B" 'pmail-summary-browse-body) | ||
| 80 | (define-key map "c" 'pmail-summary-continue) | ||
| 81 | (define-key map "d" 'pmail-summary-delete-forward) | ||
| 82 | (define-key map "\C-d" 'pmail-summary-delete-backward) | ||
| 83 | (define-key map "e" 'pmail-summary-edit-current-message) | ||
| 84 | (define-key map "f" 'pmail-summary-forward) | ||
| 85 | (define-key map "g" 'pmail-summary-get-new-mail) | ||
| 86 | (define-key map "h" 'pmail-summary) | ||
| 87 | (define-key map "i" 'pmail-summary-input) | ||
| 88 | (define-key map "j" 'pmail-summary-goto-msg) | ||
| 89 | (define-key map "\C-m" 'pmail-summary-goto-msg) | ||
| 90 | (define-key map "k" 'pmail-summary-kill-label) | ||
| 91 | (define-key map "l" 'pmail-summary-by-labels) | ||
| 92 | (define-key map "\e\C-h" 'pmail-summary) | ||
| 93 | (define-key map "\e\C-l" 'pmail-summary-by-labels) | ||
| 94 | (define-key map "\e\C-r" 'pmail-summary-by-recipients) | ||
| 95 | (define-key map "\e\C-f" 'pmail-summary-by-senders) | ||
| 96 | (define-key map "\e\C-s" 'pmail-summary-by-regexp) | ||
| 97 | (define-key map "\e\C-t" 'pmail-summary-by-topic) | ||
| 98 | (define-key map "m" 'pmail-summary-mail) | ||
| 99 | (define-key map "\M-m" 'pmail-summary-retry-failure) | ||
| 100 | (define-key map "n" 'pmail-summary-next-msg) | ||
| 101 | (define-key map "\en" 'pmail-summary-next-all) | ||
| 102 | (define-key map "\e\C-n" 'pmail-summary-next-labeled-message) | ||
| 103 | (define-key map "o" 'pmail-summary-output) | ||
| 104 | (define-key map "\C-o" 'pmail-summary-output) | ||
| 105 | (define-key map "p" 'pmail-summary-previous-msg) | ||
| 106 | (define-key map "\ep" 'pmail-summary-previous-all) | ||
| 107 | (define-key map "\e\C-p" 'pmail-summary-previous-labeled-message) | ||
| 108 | (define-key map "q" 'pmail-summary-quit) | ||
| 109 | (define-key map "Q" 'pmail-summary-wipe) | ||
| 110 | (define-key map "r" 'pmail-summary-reply) | ||
| 111 | (define-key map "s" 'pmail-summary-expunge-and-save) | ||
| 112 | (define-key map "\es" 'pmail-summary-search) | ||
| 113 | (define-key map "t" 'pmail-summary-toggle-header) | ||
| 114 | (define-key map "u" 'pmail-summary-undelete) | ||
| 115 | (define-key map "\M-u" 'pmail-summary-undelete-many) | ||
| 116 | (define-key map "x" 'pmail-summary-expunge) | ||
| 117 | (define-key map "w" 'pmail-summary-output-body) | ||
| 118 | (define-key map "." 'pmail-summary-beginning-of-message) | ||
| 119 | (define-key map "/" 'pmail-summary-end-of-message) | ||
| 120 | (define-key map "<" 'pmail-summary-first-message) | ||
| 121 | (define-key map ">" 'pmail-summary-last-message) | ||
| 122 | (define-key map " " 'pmail-summary-scroll-msg-up) | ||
| 123 | (define-key map "\177" 'pmail-summary-scroll-msg-down) | ||
| 124 | (define-key map "?" 'describe-mode) | ||
| 125 | (define-key map "\C-c\C-n" 'pmail-summary-next-same-subject) | ||
| 126 | (define-key map "\C-c\C-p" 'pmail-summary-previous-same-subject) | ||
| 127 | (define-key map "\C-c\C-s\C-d" 'pmail-summary-sort-by-date) | ||
| 128 | (define-key map "\C-c\C-s\C-s" 'pmail-summary-sort-by-subject) | ||
| 129 | (define-key map "\C-c\C-s\C-a" 'pmail-summary-sort-by-author) | ||
| 130 | (define-key map "\C-c\C-s\C-r" 'pmail-summary-sort-by-recipient) | ||
| 131 | (define-key map "\C-c\C-s\C-c" 'pmail-summary-sort-by-correspondent) | ||
| 132 | (define-key map "\C-c\C-s\C-l" 'pmail-summary-sort-by-lines) | ||
| 133 | (define-key map "\C-c\C-s\C-k" 'pmail-summary-sort-by-labels) | ||
| 134 | (define-key map [menu-bar] (make-sparse-keymap)) | ||
| 135 | (define-key map [menu-bar classify] | ||
| 136 | (cons "Classify" (make-sparse-keymap "Classify"))) | ||
| 137 | (define-key map [menu-bar classify output-menu] | ||
| 138 | '("Output (Pmail Menu)..." . pmail-summary-output-menu)) | ||
| 139 | (define-key map [menu-bar classify input-menu] | ||
| 140 | '("Input Pmail File (menu)..." . pmail-input-menu)) | ||
| 141 | (define-key map [menu-bar classify input-menu] '(nil)) | ||
| 142 | (define-key map [menu-bar classify output-menu] '(nil)) | ||
| 143 | (define-key map [menu-bar classify output-body] | ||
| 144 | '("Output (body)..." . pmail-summary-output-body)) | ||
| 145 | (define-key map [menu-bar classify output-inbox] | ||
| 146 | '("Output (inbox)..." . pmail-summary-output)) | ||
| 147 | (define-key map [menu-bar classify output] | ||
| 148 | '("Output (Pmail)..." . pmail-summary-output)) | ||
| 149 | (define-key map [menu-bar classify kill-label] | ||
| 150 | '("Kill Label..." . pmail-summary-kill-label)) | ||
| 151 | (define-key map [menu-bar classify add-label] | ||
| 152 | '("Add Label..." . pmail-summary-add-label)) | ||
| 153 | (define-key map [menu-bar summary] | ||
| 154 | (cons "Summary" (make-sparse-keymap "Summary"))) | ||
| 155 | (define-key map [menu-bar summary senders] | ||
| 156 | '("By Senders..." . pmail-summary-by-senders)) | ||
| 157 | (define-key map [menu-bar summary labels] | ||
| 158 | '("By Labels..." . pmail-summary-by-labels)) | ||
| 159 | (define-key map [menu-bar summary recipients] | ||
| 160 | '("By Recipients..." . pmail-summary-by-recipients)) | ||
| 161 | (define-key map [menu-bar summary topic] | ||
| 162 | '("By Topic..." . pmail-summary-by-topic)) | ||
| 163 | (define-key map [menu-bar summary regexp] | ||
| 164 | '("By Regexp..." . pmail-summary-by-regexp)) | ||
| 165 | (define-key map [menu-bar summary all] | ||
| 166 | '("All" . pmail-summary)) | ||
| 167 | (define-key map [menu-bar mail] | ||
| 168 | (cons "Mail" (make-sparse-keymap "Mail"))) | ||
| 169 | (define-key map [menu-bar mail pmail-summary-get-new-mail] | ||
| 170 | '("Get New Mail" . pmail-summary-get-new-mail)) | ||
| 171 | (define-key map [menu-bar mail lambda] | ||
| 172 | '("----")) | ||
| 173 | (define-key map [menu-bar mail continue] | ||
| 174 | '("Continue" . pmail-summary-continue)) | ||
| 175 | (define-key map [menu-bar mail resend] | ||
| 176 | '("Re-send..." . pmail-summary-resend)) | ||
| 177 | (define-key map [menu-bar mail forward] | ||
| 178 | '("Forward" . pmail-summary-forward)) | ||
| 179 | (define-key map [menu-bar mail retry] | ||
| 180 | '("Retry" . pmail-summary-retry-failure)) | ||
| 181 | (define-key map [menu-bar mail reply] | ||
| 182 | '("Reply" . pmail-summary-reply)) | ||
| 183 | (define-key map [menu-bar mail mail] | ||
| 184 | '("Mail" . pmail-summary-mail)) | ||
| 185 | (define-key map [menu-bar delete] | ||
| 186 | (cons "Delete" (make-sparse-keymap "Delete"))) | ||
| 187 | (define-key map [menu-bar delete expunge/save] | ||
| 188 | '("Expunge/Save" . pmail-summary-expunge-and-save)) | ||
| 189 | (define-key map [menu-bar delete expunge] | ||
| 190 | '("Expunge" . pmail-summary-expunge)) | ||
| 191 | (define-key map [menu-bar delete undelete] | ||
| 192 | '("Undelete" . pmail-summary-undelete)) | ||
| 193 | (define-key map [menu-bar delete delete] | ||
| 194 | '("Delete" . pmail-summary-delete-forward)) | ||
| 195 | (define-key map [menu-bar move] | ||
| 196 | (cons "Move" (make-sparse-keymap "Move"))) | ||
| 197 | (define-key map [menu-bar move search-back] | ||
| 198 | '("Search Back..." . pmail-summary-search-backward)) | ||
| 199 | (define-key map [menu-bar move search] | ||
| 200 | '("Search..." . pmail-summary-search)) | ||
| 201 | (define-key map [menu-bar move previous] | ||
| 202 | '("Previous Nondeleted" . pmail-summary-previous-msg)) | ||
| 203 | (define-key map [menu-bar move next] | ||
| 204 | '("Next Nondeleted" . pmail-summary-next-msg)) | ||
| 205 | (define-key map [menu-bar move last] | ||
| 206 | '("Last" . pmail-summary-last-message)) | ||
| 207 | (define-key map [menu-bar move first] | ||
| 208 | '("First" . pmail-summary-first-message)) | ||
| 209 | (define-key map [menu-bar move previous] | ||
| 210 | '("Previous" . pmail-summary-previous-all)) | ||
| 211 | (define-key map [menu-bar move next] | ||
| 212 | '("Next" . pmail-summary-next-all)) | ||
| 213 | map) | ||
| 214 | "Keymap for `pmail-summary-mode'.") | ||
| 215 | |||
| 216 | (declare-function pmail-abort-edit "pmailedit" ()) | ||
| 217 | (declare-function pmail-cease-edit "pmailedit"()) | ||
| 218 | (declare-function pmail-set-label "pmailkwd" (l state &optional n)) | ||
| 219 | (declare-function pmail-output-read-file-name "pmailout" ()) | ||
| 220 | (declare-function mail-comma-list-regexp "mail-utils" (labels)) | ||
| 221 | (declare-function mail-send-and-exit "sendmail" (&optional arg)) | ||
| 222 | (declare-function mail-strip-quoted-names "mail-utils" (address)) | ||
| 223 | 67 | ||
| 224 | ;; Entry points for making a summary buffer. | 68 | ;; Entry points for making a summary buffer. |
| 225 | 69 | ||
| @@ -247,7 +91,7 @@ LABELS should be a string containing the desired labels, separated by commas." | |||
| 247 | (pmail-new-summary (concat "labels " labels) | 91 | (pmail-new-summary (concat "labels " labels) |
| 248 | (list 'pmail-summary-by-labels labels) | 92 | (list 'pmail-summary-by-labels labels) |
| 249 | 'pmail-message-labels-p | 93 | 'pmail-message-labels-p |
| 250 | (mail-comma-list-regexp labels))) | 94 | (concat ", \\(" (mail-comma-list-regexp labels) "\\),"))) |
| 251 | 95 | ||
| 252 | ;;;###autoload | 96 | ;;;###autoload |
| 253 | (defun pmail-summary-by-recipients (recipients &optional primary-only) | 97 | (defun pmail-summary-by-recipients (recipients &optional primary-only) |
| @@ -279,6 +123,9 @@ Emacs will list the header line in the PMAIL-summary." | |||
| 279 | 'pmail-message-regexp-p | 123 | 'pmail-message-regexp-p |
| 280 | regexp)) | 124 | regexp)) |
| 281 | 125 | ||
| 126 | ;; pmail-summary-by-topic | ||
| 127 | ;; 1989 R.A. Schnitzler | ||
| 128 | |||
| 282 | ;;;###autoload | 129 | ;;;###autoload |
| 283 | (defun pmail-summary-by-topic (subject &optional whole-message) | 130 | (defun pmail-summary-by-topic (subject &optional whole-message) |
| 284 | "Display a summary of all messages with the given SUBJECT. | 131 | "Display a summary of all messages with the given SUBJECT. |
| @@ -289,6 +136,8 @@ SUBJECT is a string of regexps separated by commas." | |||
| 289 | (interactive | 136 | (interactive |
| 290 | (let* ((subject (with-current-buffer pmail-buffer | 137 | (let* ((subject (with-current-buffer pmail-buffer |
| 291 | (pmail-current-subject))) | 138 | (pmail-current-subject))) |
| 139 | (subject-re (with-current-buffer pmail-buffer | ||
| 140 | (pmail-current-subject-regexp))) | ||
| 292 | (prompt (concat "Topics to summarize by (regexp" | 141 | (prompt (concat "Topics to summarize by (regexp" |
| 293 | (if subject ", default current subject" "") | 142 | (if subject ", default current subject" "") |
| 294 | "): "))) | 143 | "): "))) |
| @@ -300,115 +149,56 @@ SUBJECT is a string of regexps separated by commas." | |||
| 300 | (mail-comma-list-regexp subject) whole-message)) | 149 | (mail-comma-list-regexp subject) whole-message)) |
| 301 | 150 | ||
| 302 | (defun pmail-message-subject-p (msg subject &optional whole-message) | 151 | (defun pmail-message-subject-p (msg subject &optional whole-message) |
| 303 | "Return non-nil if SUBJECT is found in MSG. | ||
| 304 | If WHOLE-MESSAGE is nil only the subject header will be searched, | ||
| 305 | otherwise the whole message will be searched for text matching | ||
| 306 | SUBJECT. Return nil to indicate that SUBJECT is not found, | ||
| 307 | non-nil otherwise." | ||
| 308 | (save-restriction | 152 | (save-restriction |
| 153 | (goto-char (pmail-msgbeg msg)) | ||
| 154 | (search-forward "\n*** EOOH ***\n" (pmail-msgend msg) 'move) | ||
| 309 | (narrow-to-region | 155 | (narrow-to-region |
| 310 | (pmail-desc-get-start msg) | 156 | (point) |
| 311 | (pmail-desc-get-end msg)) | 157 | (progn (search-forward (if whole-message "\^_" "\n\n")) (point))) |
| 312 | (goto-char (point-min)) | 158 | (goto-char (point-min)) |
| 313 | (if whole-message | 159 | (if whole-message (re-search-forward subject nil t) |
| 314 | (re-search-forward subject nil t)) | 160 | (string-match subject (let ((subj (mail-fetch-field "Subject"))) |
| 315 | (string-match subject | 161 | (if subj |
| 316 | (let ((subj (pmail-header-get-header "subject"))) | 162 | (funcall pmail-summary-line-decoder subj) |
| 317 | (if subj | 163 | "")))))) |
| 318 | (funcall pmail-summary-line-decoder subj) | ||
| 319 | ""))))) | ||
| 320 | 164 | ||
| 321 | ;;;###autoload | 165 | ;;;###autoload |
| 322 | (defun pmail-summary-by-senders (senders) | 166 | (defun pmail-summary-by-senders (senders) |
| 323 | "Display a summary of all messages with the given SENDERS. | 167 | "Display a summary of all messages with the given SENDERS. |
| 324 | SENDERS is a string of names separated by commas." | 168 | SENDERS is a string of names separated by commas." |
| 325 | (interactive | 169 | (interactive "sSenders to summarize by: ") |
| 326 | (let* ((sender (when pmail-current-message | ||
| 327 | (pmail-desc-get-sender pmail-current-message))) | ||
| 328 | (sender-re (with-current-buffer pmail-buffer | ||
| 329 | (regexp-quote sender))) | ||
| 330 | (prompt (concat "Senders to summarize by (regexp" | ||
| 331 | (if sender ", default current sender" "") | ||
| 332 | "): "))) | ||
| 333 | (list (read-string prompt nil nil sender)))) | ||
| 334 | (pmail-new-summary | 170 | (pmail-new-summary |
| 335 | (concat "senders " senders) | 171 | (concat "senders " senders) |
| 336 | (list 'pmail-summary-by-senders senders) | 172 | (list 'pmail-summary-by-senders senders) |
| 337 | 'pmail-message-senders-p | 173 | 'pmail-message-senders-p |
| 338 | (mail-comma-list-regexp senders))) | 174 | (mail-comma-list-regexp senders))) |
| 339 | 175 | ||
| 340 | (defun pmail-message-senders-p (msg sender) | 176 | (defun pmail-message-senders-p (msg senders) |
| 341 | "Return non-nil if SENDER is found in MSG. | ||
| 342 | The From header is tested." | ||
| 343 | (save-restriction | 177 | (save-restriction |
| 344 | (narrow-to-region | 178 | (goto-char (pmail-msgbeg msg)) |
| 345 | (pmail-desc-get-start msg) | 179 | (search-forward "\n*** EOOH ***\n") |
| 346 | (pmail-desc-get-end msg)) | 180 | (narrow-to-region (point) (progn (search-forward "\n\n") (point))) |
| 347 | (goto-char (point-min)) | 181 | (string-match senders (or (mail-fetch-field "From") "")))) |
| 348 | (string-match sender (or (mail-fetch-field "From") "")))) | ||
| 349 | 182 | ||
| 350 | ;;;; General making of a summary buffer. | 183 | ;; General making of a summary buffer. |
| 351 | 184 | ||
| 352 | (defvar pmail-summary-symbol-number 0) | 185 | (defvar pmail-summary-symbol-number 0) |
| 353 | 186 | ||
| 354 | (defun pmail-new-summary (description redo-form function &rest args) | 187 | (defvar pmail-new-summary-line-count) |
| 188 | |||
| 189 | (defun pmail-new-summary (desc redo func &rest args) | ||
| 355 | "Create a summary of selected messages. | 190 | "Create a summary of selected messages. |
| 356 | DESCRIPTION makes part of the mode line of the summary buffer. | 191 | DESC makes part of the mode line of the summary buffer. REDO is form ... |
| 357 | For each message, FUNCTION is applied to the message number and ARGS... | 192 | For each message, FUNC is applied to the message number and ARGS... |
| 358 | and if the result is non-nil, that message is included. | 193 | and if the result is non-nil, that message is included. |
| 359 | nil for FUNCTION means all messages." | 194 | nil for FUNCTION means all messages." |
| 360 | (message "Computing summary lines...") | 195 | (message "Computing summary lines...") |
| 361 | (let ((summary-msgs ()) | 196 | (let (mesg was-in-summary) |
| 362 | (new-summary-line-count 0) | 197 | (with-current-buffer pmail-buffer |
| 363 | (msgnum 1) | ||
| 364 | current-message sumbuf was-in-summary) | ||
| 365 | (save-excursion | ||
| 366 | ;; Go to the Pmail buffer. | ||
| 367 | (if (eq major-mode 'pmail-summary-mode) | 198 | (if (eq major-mode 'pmail-summary-mode) |
| 368 | (setq was-in-summary t)) | 199 | (setq was-in-summary t)) |
| 369 | (set-buffer pmail-buffer) | 200 | (setq mesg pmail-current-message |
| 370 | ;; Find its summary buffer, or make one. | 201 | pmail-summary-buffer (pmail-new-summary-1 desc redo func args))) |
| 371 | (setq current-message pmail-current-message | ||
| 372 | sumbuf | ||
| 373 | (if (and pmail-summary-buffer | ||
| 374 | (buffer-name pmail-summary-buffer)) | ||
| 375 | pmail-summary-buffer | ||
| 376 | (generate-new-buffer (concat (buffer-name) "-summary")))) | ||
| 377 | ;; Collect the message summaries based on the filtering | ||
| 378 | ;; argument (FUNCTION). | ||
| 379 | (while (>= pmail-total-messages msgnum) | ||
| 380 | (if (or (null function) | ||
| 381 | (apply function (cons msgnum args))) | ||
| 382 | (setq summary-msgs | ||
| 383 | (cons (cons msgnum (pmail-summary-get-summary-line msgnum)) | ||
| 384 | summary-msgs))) | ||
| 385 | (setq msgnum (1+ msgnum))) | ||
| 386 | (setq summary-msgs (nreverse summary-msgs)) | ||
| 387 | ;; Place the collected summaries into the summary buffer. | ||
| 388 | (setq pmail-summary-buffer nil) | ||
| 389 | (save-excursion | ||
| 390 | (let ((rbuf (current-buffer)) | ||
| 391 | (vbuf pmail-view-buffer) | ||
| 392 | (total pmail-total-messages)) | ||
| 393 | (set-buffer sumbuf) | ||
| 394 | ;; Set up the summary buffer's contents. | ||
| 395 | (let ((buffer-read-only nil)) | ||
| 396 | (erase-buffer) | ||
| 397 | (while summary-msgs | ||
| 398 | (princ (cdr (car summary-msgs)) sumbuf) | ||
| 399 | (setq summary-msgs (cdr summary-msgs))) | ||
| 400 | (goto-char (point-min))) | ||
| 401 | ;; Set up the rest of its state and local variables. | ||
| 402 | (setq buffer-read-only t) | ||
| 403 | (pmail-summary-mode) | ||
| 404 | (make-local-variable 'minor-mode-alist) | ||
| 405 | (setq minor-mode-alist (list (list t (concat ": " description)))) | ||
| 406 | (setq pmail-buffer rbuf | ||
| 407 | pmail-view-buffer vbuf | ||
| 408 | pmail-summary-redo redo-form | ||
| 409 | pmail-total-messages total | ||
| 410 | pmail-current-message current-message))) | ||
| 411 | (setq pmail-summary-buffer sumbuf)) | ||
| 412 | ;; Now display the summary buffer and go to the right place in it. | 202 | ;; Now display the summary buffer and go to the right place in it. |
| 413 | (or was-in-summary | 203 | (or was-in-summary |
| 414 | (progn | 204 | (progn |
| @@ -418,22 +208,118 @@ nil for FUNCTION means all messages." | |||
| 418 | (progn | 208 | (progn |
| 419 | (split-window (selected-window) pmail-summary-window-size) | 209 | (split-window (selected-window) pmail-summary-window-size) |
| 420 | (select-window (next-window (frame-first-window))) | 210 | (select-window (next-window (frame-first-window))) |
| 421 | (pop-to-buffer sumbuf) | 211 | (pop-to-buffer pmail-summary-buffer) |
| 422 | ;; If pop-to-buffer did not use that window, delete that | 212 | ;; If pop-to-buffer did not use that window, delete that |
| 423 | ;; window. (This can happen if it uses another frame.) | 213 | ;; window. (This can happen if it uses another frame.) |
| 424 | (if (not (eq sumbuf (window-buffer (frame-first-window)))) | 214 | (if (not (eq pmail-summary-buffer (window-buffer (frame-first-window)))) |
| 425 | (delete-other-windows))) | 215 | (delete-other-windows))) |
| 426 | (pop-to-buffer sumbuf)) | 216 | (pop-to-buffer pmail-summary-buffer)) |
| 427 | (set-buffer pmail-buffer) | 217 | (set-buffer pmail-buffer) |
| 428 | ;; This is how pmail makes the summary buffer reappear. | 218 | ;; This is how pmail makes the summary buffer reappear. |
| 429 | ;; We do this here to make the window the proper size. | 219 | ;; We do this here to make the window the proper size. |
| 430 | (pmail-select-summary nil) | 220 | (pmail-select-summary nil) |
| 431 | (set-buffer pmail-summary-buffer))) | 221 | (set-buffer pmail-summary-buffer))) |
| 432 | (pmail-summary-goto-msg current-message nil t) | 222 | (pmail-summary-goto-msg mesg t t) |
| 433 | (pmail-summary-construct-io-menu) | 223 | (pmail-summary-construct-io-menu) |
| 434 | (message "Computing summary lines...done"))) | 224 | (message "Computing summary lines...done"))) |
| 225 | |||
| 226 | (defun pmail-new-summary-1 (description form function &rest args) | ||
| 227 | "Filter messages to obtain summary lines. | ||
| 228 | DESCRIPTION is added to the mode line. | ||
| 229 | |||
| 230 | Return the summary buffer by invoking FUNCTION on each message | ||
| 231 | passing the message number and ARGS... | ||
| 232 | |||
| 233 | REDO is a form ... | ||
| 234 | |||
| 235 | The current buffer must be a Pmail buffer either containing a | ||
| 236 | collection of mbox formatted messages or displaying a single | ||
| 237 | message." | ||
| 238 | (let ((summary-msgs ()) | ||
| 239 | (pmail-new-summary-line-count 0) | ||
| 240 | (sumbuf (pmail-get-create-summary-buffer))) | ||
| 241 | (let ((swap (pmail-use-collection-buffer)) | ||
| 242 | (msgnum 1) | ||
| 243 | (buffer-read-only nil) | ||
| 244 | (old-min (point-min-marker)) | ||
| 245 | (old-max (point-max-marker))) | ||
| 246 | ;; Can't use save-restriction here; that doesn't work if we | ||
| 247 | ;; plan to modify text outside the original restriction. | ||
| 248 | (save-excursion | ||
| 249 | (widen) | ||
| 250 | (goto-char (point-min)) | ||
| 251 | (while (>= pmail-total-messages msgnum) | ||
| 252 | (if (or (null function) | ||
| 253 | (apply function (cons msgnum args))) | ||
| 254 | (setq summary-msgs | ||
| 255 | (cons (cons msgnum (pmail-get-summary msgnum)) | ||
| 256 | summary-msgs))) | ||
| 257 | (setq msgnum (1+ msgnum)) | ||
| 258 | ;; Provide a periodic User progress message. | ||
| 259 | (if (zerop (% pmail-new-summary-line-count 10)) | ||
| 260 | (message "Computing summary lines...%d" | ||
| 261 | pmail-new-summary-line-count))) | ||
| 262 | (setq summary-msgs (nreverse summary-msgs))) | ||
| 263 | (narrow-to-region old-min old-max)) | ||
| 264 | |||
| 265 | ;; Temporarily, while summary buffer is unfinished, | ||
| 266 | ;; we "don't have" a summary. | ||
| 267 | ;; | ||
| 268 | ;; I have not a clue what this clause is doing. If you read this | ||
| 269 | ;; chunk of code and have a clue, then please email that clue to | ||
| 270 | ;; pmr@pajato.com | ||
| 271 | (setq pmail-summary-buffer nil) | ||
| 272 | (if pmail-enable-mime | ||
| 273 | (with-current-buffer pmail-buffer | ||
| 274 | (setq pmail-summary-buffer nil))) | ||
| 275 | |||
| 276 | (save-excursion | ||
| 277 | (let ((rbuf (current-buffer)) | ||
| 278 | (total pmail-total-messages)) | ||
| 279 | (set-buffer sumbuf) | ||
| 280 | ;; Set up the summary buffer's contents. | ||
| 281 | (let ((buffer-read-only nil)) | ||
| 282 | (erase-buffer) | ||
| 283 | (while summary-msgs | ||
| 284 | (princ (cdr (car summary-msgs)) sumbuf) | ||
| 285 | (setq summary-msgs (cdr summary-msgs))) | ||
| 286 | (goto-char (point-min))) | ||
| 287 | ;; Set up the rest of its state and local variables. | ||
| 288 | (setq buffer-read-only t) | ||
| 289 | (pmail-summary-mode) | ||
| 290 | (make-local-variable 'minor-mode-alist) | ||
| 291 | (setq minor-mode-alist (list (list t (concat ": " description)))) | ||
| 292 | (setq pmail-buffer rbuf | ||
| 293 | pmail-summary-redo form | ||
| 294 | pmail-total-messages total))) | ||
| 295 | sumbuf)) | ||
| 296 | |||
| 297 | (defun pmail-get-create-summary-buffer () | ||
| 298 | "Obtain a summary buffer by re-using an existing summary | ||
| 299 | buffer, or by creating a new summary buffer." | ||
| 300 | (if (and pmail-summary-buffer (buffer-name pmail-summary-buffer)) | ||
| 301 | pmail-summary-buffer | ||
| 302 | (generate-new-buffer (concat (buffer-name) "-summary")))) | ||
| 303 | |||
| 435 | 304 | ||
| 436 | ;;;; Low levels of generating a summary. | 305 | ;; Low levels of generating a summary. |
| 306 | |||
| 307 | (defun pmail-get-summary (msgnum) | ||
| 308 | "Return the summary line for message MSGNUM. | ||
| 309 | If the message has a summary line already, it will be stored in | ||
| 310 | the message as a header and simply returned, otherwise the | ||
| 311 | summary line is created, saved in the message header, cached and | ||
| 312 | returned. | ||
| 313 | |||
| 314 | The current buffer contains the unrestricted message collection." | ||
| 315 | (let ((line (aref pmail-summary-vector (1- msgnum)))) | ||
| 316 | (unless line | ||
| 317 | ;; Register a summary line for MSGNUM. | ||
| 318 | (setq pmail-new-summary-line-count (1+ pmail-new-summary-line-count) | ||
| 319 | line (pmail-get-create-summary-line msgnum)) | ||
| 320 | ;; Cache the summary line for use during this Pmail session. | ||
| 321 | (aset pmail-summary-vector (1- msgnum) line)) | ||
| 322 | line)) | ||
| 437 | 323 | ||
| 438 | ;;;###autoload | 324 | ;;;###autoload |
| 439 | (defcustom pmail-summary-line-decoder (function identity) | 325 | (defcustom pmail-summary-line-decoder (function identity) |
| @@ -443,41 +329,205 @@ By default, `identity' is set." | |||
| 443 | :type 'function | 329 | :type 'function |
| 444 | :group 'pmail-summary) | 330 | :group 'pmail-summary) |
| 445 | 331 | ||
| 332 | (defun pmail-get-create-summary-line (msgnum) | ||
| 333 | "Return the summary line for message MSGNUM. | ||
| 334 | Obtain the message summary from the header if it is available | ||
| 335 | otherwise create it and store it in the message header. | ||
| 336 | |||
| 337 | The current buffer contains the unrestricted message collection." | ||
| 338 | (let ((beg (pmail-msgbeg msgnum)) | ||
| 339 | (end (pmail-msgend msgnum)) | ||
| 340 | result) | ||
| 341 | (goto-char beg) | ||
| 342 | (if (search-forward "\n\n" end t) | ||
| 343 | (save-restriction | ||
| 344 | (narrow-to-region beg (point)) | ||
| 345 | ;; Generate a status line from the message and put it in the | ||
| 346 | ;; message. | ||
| 347 | (setq result (mail-fetch-field pmail-summary-header)) | ||
| 348 | (unless result | ||
| 349 | (setq result (pmail-create-summary msgnum)) | ||
| 350 | (pmail-add-header pmail-summary-header result))) | ||
| 351 | (pmail-error-bad-format msgnum)) | ||
| 352 | result)) | ||
| 353 | |||
| 354 | (defun pmail-get-summary-labels () | ||
| 355 | "Return a coded string wrapped in curly braces denoting the status labels. | ||
| 356 | |||
| 357 | The current buffer is narrowed to the message headers for | ||
| 358 | the message being processed." | ||
| 359 | (let ((status (mail-fetch-field pmail-attribute-header)) | ||
| 360 | (index 0) | ||
| 361 | (result "") | ||
| 362 | char) | ||
| 363 | ;; Strip off the read/unread and the deleted attribute which are | ||
| 364 | ;; handled separately. | ||
| 365 | (setq status (concat (substring status 0 1) (substring status 2 6))) | ||
| 366 | (while (< index (length status)) | ||
| 367 | (unless (string= "-" (setq char (substring status index (1+ index)))) | ||
| 368 | (setq result (concat result char))) | ||
| 369 | (setq index (1+ index))) | ||
| 370 | (when (> (length result) 0) | ||
| 371 | (setq result (concat "{" result "}"))) | ||
| 372 | result)) | ||
| 373 | |||
| 374 | (defun pmail-create-summary (msgnum) | ||
| 375 | "Return the summary line for message MSGNUM. | ||
| 376 | The current buffer is narrowed to the header for message MSGNUM." | ||
| 377 | (goto-char (point-min)) | ||
| 378 | (let ((line (pmail-make-basic-summary-line)) | ||
| 379 | (labels (pmail-get-summary-labels)) | ||
| 380 | pos prefix status suffix) | ||
| 381 | (setq pos (string-match "#" line) | ||
| 382 | status (cond | ||
| 383 | ((pmail-message-deleted-p msgnum) ?D) | ||
| 384 | ((pmail-message-unseen-p msgnum) ?-) | ||
| 385 | (t ? )) | ||
| 386 | prefix (format "%5d%c %s" msgnum status (substring line 0 pos)) | ||
| 387 | suffix (substring line (1+ pos))) | ||
| 388 | (funcall pmail-summary-line-decoder (concat prefix labels suffix)))) | ||
| 389 | |||
| 446 | ;;;###autoload | 390 | ;;;###autoload |
| 447 | (defcustom pmail-user-mail-address-regexp | 391 | (defcustom pmail-user-mail-address-regexp nil |
| 448 | (concat "^\\(" | ||
| 449 | (regexp-quote (user-login-name)) | ||
| 450 | "\\($\\|@\\)\\|" | ||
| 451 | (regexp-quote | ||
| 452 | (or user-mail-address | ||
| 453 | (concat (user-login-name) "@" | ||
| 454 | (or mail-host-address | ||
| 455 | (system-name))))) | ||
| 456 | "\\>\\)") | ||
| 457 | "*Regexp matching user mail addresses. | 392 | "*Regexp matching user mail addresses. |
| 458 | If non-nil, this variable is used to identify the correspondent | 393 | If non-nil, this variable is used to identify the correspondent |
| 459 | when receiving new mail. If it matches the address of the | 394 | when receiving new mail. If it matches the address of the sender, |
| 460 | sender, the recipient is taken as correspondent of a mail. It is | 395 | the recipient is taken as correspondent of a mail. |
| 461 | initialized based on your `user-login-name' and | 396 | If nil \(default value\), your `user-login-name' and `user-mail-address' |
| 462 | `user-mail-address'. | 397 | are used to exclude yourself as correspondent. |
| 463 | 398 | ||
| 464 | Usually you don't have to set this variable, except if you | 399 | Usually you don't have to set this variable, except if you collect mails |
| 465 | collect mails sent by you under different user names. Then it | 400 | sent by you under different user names. |
| 466 | should be a regexp matching your mail addresses. | 401 | Then it should be a regexp matching your mail addresses. |
| 467 | 402 | ||
| 468 | Setting this variable has an effect only before reading a mail." | 403 | Setting this variable has an effect only before reading a mail." |
| 469 | :type '(choice (const :tag "None" nil) regexp) | 404 | :type '(choice (const :tag "None" nil) regexp) |
| 470 | :group 'pmail-retrieve | 405 | :group 'pmail-retrieve |
| 471 | :version "21.1") | 406 | :version "21.1") |
| 472 | 407 | ||
| 408 | (defun pmail-make-basic-summary-line () | ||
| 409 | (goto-char (point-min)) | ||
| 410 | (concat (save-excursion | ||
| 411 | (if (not (re-search-forward "^Date:" nil t)) | ||
| 412 | " " | ||
| 413 | (cond ((re-search-forward "\\([^0-9:]\\)\\([0-3]?[0-9]\\)\\([- \t_]+\\)\\([adfjmnos][aceopu][bcglnprtvy]\\)" | ||
| 414 | (save-excursion (end-of-line) (point)) t) | ||
| 415 | (format "%2d-%3s" | ||
| 416 | (string-to-number (buffer-substring | ||
| 417 | (match-beginning 2) | ||
| 418 | (match-end 2))) | ||
| 419 | (buffer-substring | ||
| 420 | (match-beginning 4) (match-end 4)))) | ||
| 421 | ((re-search-forward "\\([^a-z]\\)\\([adfjmnos][acepou][bcglnprtvy]\\)\\([-a-z \t_]*\\)\\([0-9][0-9]?\\)" | ||
| 422 | (save-excursion (end-of-line) (point)) t) | ||
| 423 | (format "%2d-%3s" | ||
| 424 | (string-to-number (buffer-substring | ||
| 425 | (match-beginning 4) | ||
| 426 | (match-end 4))) | ||
| 427 | (buffer-substring | ||
| 428 | (match-beginning 2) (match-end 2)))) | ||
| 429 | ((re-search-forward "\\(19\\|20\\)\\([0-9][0-9]\\)-\\([01][0-9]\\)-\\([0-3][0-9]\\)" | ||
| 430 | (save-excursion (end-of-line) (point)) t) | ||
| 431 | (format "%2s%2s%2s" | ||
| 432 | (buffer-substring | ||
| 433 | (match-beginning 2) (match-end 2)) | ||
| 434 | (buffer-substring | ||
| 435 | (match-beginning 3) (match-end 3)) | ||
| 436 | (buffer-substring | ||
| 437 | (match-beginning 4) (match-end 4)))) | ||
| 438 | (t "??????")))) | ||
| 439 | " " | ||
| 440 | (save-excursion | ||
| 441 | (let* ((from (and (re-search-forward "^From:[ \t]*" nil t) | ||
| 442 | (mail-strip-quoted-names | ||
| 443 | (buffer-substring | ||
| 444 | (1- (point)) | ||
| 445 | ;; Get all the lines of the From field | ||
| 446 | ;; so that we get a whole comment if there is one, | ||
| 447 | ;; so that mail-strip-quoted-names can discard it. | ||
| 448 | (let ((opoint (point))) | ||
| 449 | (while (progn (forward-line 1) | ||
| 450 | (looking-at "[ \t]"))) | ||
| 451 | ;; Back up over newline, then trailing spaces or tabs | ||
| 452 | (forward-char -1) | ||
| 453 | (skip-chars-backward " \t") | ||
| 454 | (point)))))) | ||
| 455 | len mch lo) | ||
| 456 | (if (or (null from) | ||
| 457 | (string-match | ||
| 458 | (or pmail-user-mail-address-regexp | ||
| 459 | (concat "^\\(" | ||
| 460 | (regexp-quote (user-login-name)) | ||
| 461 | "\\($\\|@\\)\\|" | ||
| 462 | (regexp-quote | ||
| 463 | ;; Don't lose if run from init file | ||
| 464 | ;; where user-mail-address is not | ||
| 465 | ;; set yet. | ||
| 466 | (or user-mail-address | ||
| 467 | (concat (user-login-name) "@" | ||
| 468 | (or mail-host-address | ||
| 469 | (system-name))))) | ||
| 470 | "\\>\\)")) | ||
| 471 | from)) | ||
| 472 | ;; No From field, or it's this user. | ||
| 473 | (save-excursion | ||
| 474 | (goto-char (point-min)) | ||
| 475 | (if (not (re-search-forward "^To:[ \t]*" nil t)) | ||
| 476 | nil | ||
| 477 | (setq from | ||
| 478 | (concat "to: " | ||
| 479 | (mail-strip-quoted-names | ||
| 480 | (buffer-substring | ||
| 481 | (point) | ||
| 482 | (progn (end-of-line) | ||
| 483 | (skip-chars-backward " \t") | ||
| 484 | (point))))))))) | ||
| 485 | (if (null from) | ||
| 486 | " " | ||
| 487 | (setq len (length from)) | ||
| 488 | (setq mch (string-match "[@%]" from)) | ||
| 489 | (format "%25s" | ||
| 490 | (if (or (not mch) (<= len 25)) | ||
| 491 | (substring from (max 0 (- len 25))) | ||
| 492 | (substring from | ||
| 493 | (setq lo (cond ((< (- mch 14) 0) 0) | ||
| 494 | ((< len (+ mch 11)) | ||
| 495 | (- len 25)) | ||
| 496 | (t (- mch 14)))) | ||
| 497 | (min len (+ lo 25)))))))) | ||
| 498 | (if pmail-summary-line-count-flag | ||
| 499 | (save-excursion | ||
| 500 | (save-restriction | ||
| 501 | (widen) | ||
| 502 | (let ((beg (pmail-msgbeg msgnum)) | ||
| 503 | (end (pmail-msgend msgnum)) | ||
| 504 | lines) | ||
| 505 | (save-excursion | ||
| 506 | (goto-char beg) | ||
| 507 | ;; Count only lines in the reformatted header, | ||
| 508 | ;; if we have reformatted it. | ||
| 509 | (search-forward "\n*** EOOH ***\n" end t) | ||
| 510 | (setq lines (count-lines (point) end))) | ||
| 511 | (format (cond | ||
| 512 | ((<= lines 9) " [%d]") | ||
| 513 | ((<= lines 99) " [%d]") | ||
| 514 | ((<= lines 999) " [%3d]") | ||
| 515 | (t "[%d]")) | ||
| 516 | lines)))) | ||
| 517 | " ") | ||
| 518 | " #" ;The # is part of the format. | ||
| 519 | (if (re-search-forward "^Subject:" nil t) | ||
| 520 | (progn (skip-chars-forward " \t") | ||
| 521 | (buffer-substring (point) | ||
| 522 | (progn (end-of-line) | ||
| 523 | (point)))) | ||
| 524 | (re-search-forward "[\n][\n]+" nil t) | ||
| 525 | (buffer-substring (point) (progn (end-of-line) (point)))) | ||
| 526 | "\n")) | ||
| 473 | 527 | ||
| 474 | ;;;; Simple motion in a summary buffer. | 528 | ;; Simple motion in a summary buffer. |
| 475 | 529 | ||
| 476 | (defun pmail-summary-next-all (&optional number) | 530 | (defun pmail-summary-next-all (&optional number) |
| 477 | "Move to an nearby message. | ||
| 478 | If NUMBER is positive then move forward NUMBER messages. If NUMBER is | ||
| 479 | negative then move backwards NUMBER messages. If NUMBER is nil then | ||
| 480 | move forward one message." | ||
| 481 | (interactive "p") | 531 | (interactive "p") |
| 482 | (forward-line (if number number 1)) | 532 | (forward-line (if number number 1)) |
| 483 | ;; It doesn't look nice to move forward past the last message line. | 533 | ;; It doesn't look nice to move forward past the last message line. |
| @@ -495,14 +545,20 @@ move forward one message." | |||
| 495 | 545 | ||
| 496 | (defun pmail-summary-next-msg (&optional number) | 546 | (defun pmail-summary-next-msg (&optional number) |
| 497 | "Display next non-deleted msg from pmail file. | 547 | "Display next non-deleted msg from pmail file. |
| 498 | With optional prefix argument NUMBER, moves forward this number of | 548 | With optional prefix argument NUMBER, moves forward this number of non-deleted |
| 499 | non-deleted messages, or backward if NUMBER is negative." | 549 | messages, or backward if NUMBER is negative." |
| 500 | (interactive "p") | 550 | (interactive "p") |
| 501 | (let (msg) | 551 | (forward-line 0) |
| 502 | (with-current-buffer pmail-buffer | 552 | (and (> number 0) (end-of-line)) |
| 503 | (pmail-next-undeleted-message number) | 553 | (let ((count (if (< number 0) (- number) number)) |
| 504 | (setq msg pmail-current-message)) | 554 | (search (if (> number 0) 're-search-forward 're-search-backward)) |
| 505 | (pmail-summary-goto-msg msg))) | 555 | (non-del-msg-found nil)) |
| 556 | (while (and (> count 0) (setq non-del-msg-found | ||
| 557 | (or (funcall search "^.....[^D]" nil t) | ||
| 558 | non-del-msg-found))) | ||
| 559 | (setq count (1- count)))) | ||
| 560 | (beginning-of-line) | ||
| 561 | (display-buffer pmail-buffer)) | ||
| 506 | 562 | ||
| 507 | (defun pmail-summary-previous-msg (&optional number) | 563 | (defun pmail-summary-previous-msg (&optional number) |
| 508 | "Display previous non-deleted msg from pmail file. | 564 | "Display previous non-deleted msg from pmail file. |
| @@ -512,7 +568,7 @@ non-deleted messages." | |||
| 512 | (pmail-summary-next-msg (- (if number number 1)))) | 568 | (pmail-summary-next-msg (- (if number number 1)))) |
| 513 | 569 | ||
| 514 | (defun pmail-summary-next-labeled-message (n labels) | 570 | (defun pmail-summary-next-labeled-message (n labels) |
| 515 | "Show next message with LABEL. Defaults to last labels used. | 571 | "Show next message with LABELS. Defaults to last labels used. |
| 516 | With prefix argument N moves forward N messages with these labels." | 572 | With prefix argument N moves forward N messages with these labels." |
| 517 | (interactive "p\nsMove to next msg with labels: ") | 573 | (interactive "p\nsMove to next msg with labels: ") |
| 518 | (let (msg) | 574 | (let (msg) |
| @@ -520,10 +576,10 @@ With prefix argument N moves forward N messages with these labels." | |||
| 520 | (set-buffer pmail-buffer) | 576 | (set-buffer pmail-buffer) |
| 521 | (pmail-next-labeled-message n labels) | 577 | (pmail-next-labeled-message n labels) |
| 522 | (setq msg pmail-current-message)) | 578 | (setq msg pmail-current-message)) |
| 523 | (setq pmail-current-message msg))) | 579 | (pmail-summary-goto-msg msg))) |
| 524 | 580 | ||
| 525 | (defun pmail-summary-previous-labeled-message (n labels) | 581 | (defun pmail-summary-previous-labeled-message (n labels) |
| 526 | "Show previous message with LABEL. Defaults to last labels used. | 582 | "Show previous message with LABELS. Defaults to last labels used. |
| 527 | With prefix argument N moves backward N messages with these labels." | 583 | With prefix argument N moves backward N messages with these labels." |
| 528 | (interactive "p\nsMove to previous msg with labels: ") | 584 | (interactive "p\nsMove to previous msg with labels: ") |
| 529 | (let (msg) | 585 | (let (msg) |
| @@ -531,15 +587,52 @@ With prefix argument N moves backward N messages with these labels." | |||
| 531 | (set-buffer pmail-buffer) | 587 | (set-buffer pmail-buffer) |
| 532 | (pmail-previous-labeled-message n labels) | 588 | (pmail-previous-labeled-message n labels) |
| 533 | (setq msg pmail-current-message)) | 589 | (setq msg pmail-current-message)) |
| 534 | (setq pmail-current-message msg))) | 590 | (pmail-summary-goto-msg msg))) |
| 535 | 591 | ||
| 536 | (defun pmail-summary-next-same-subject (n) | 592 | (defun pmail-summary-next-same-subject (n) |
| 537 | "Go to the next message in the summary having the same subject. | 593 | "Go to the next message in the summary having the same subject. |
| 538 | With prefix argument N, do this N times. | 594 | With prefix argument N, do this N times. |
| 539 | If N is negative, go backwards." | 595 | If N is negative, go backwards." |
| 540 | (interactive "p") | 596 | (interactive "p") |
| 541 | (with-current-buffer pmail-buffer | 597 | (let ((forward (> n 0)) |
| 542 | (pmail-next-same-subject n))) | 598 | search-regexp i found) |
| 599 | (with-current-buffer pmail-buffer | ||
| 600 | (setq search-regexp (pmail-current-subject-regexp) | ||
| 601 | i pmail-current-message)) | ||
| 602 | (save-excursion | ||
| 603 | (while (and (/= n 0) | ||
| 604 | (if forward | ||
| 605 | (not (eobp)) | ||
| 606 | (not (bobp)))) | ||
| 607 | (let (done) | ||
| 608 | (while (and (not done) | ||
| 609 | (if forward | ||
| 610 | (not (eobp)) | ||
| 611 | (not (bobp)))) | ||
| 612 | ;; Advance thru summary. | ||
| 613 | (forward-line (if forward 1 -1)) | ||
| 614 | ;; Get msg number of this line. | ||
| 615 | (setq i (string-to-number | ||
| 616 | (buffer-substring (point) | ||
| 617 | (min (point-max) (+ 6 (point)))))) | ||
| 618 | ;; See if that msg has desired subject. | ||
| 619 | (save-excursion | ||
| 620 | (set-buffer pmail-buffer) | ||
| 621 | (save-restriction | ||
| 622 | (widen) | ||
| 623 | (goto-char (pmail-msgbeg i)) | ||
| 624 | (search-forward "\n*** EOOH ***\n") | ||
| 625 | (let ((beg (point)) end) | ||
| 626 | (search-forward "\n\n") | ||
| 627 | (setq end (point)) | ||
| 628 | (goto-char beg) | ||
| 629 | (setq done (re-search-forward search-regexp end t)))))) | ||
| 630 | (if done (setq found i))) | ||
| 631 | (setq n (if forward (1- n) (1+ n))))) | ||
| 632 | (if found | ||
| 633 | (pmail-summary-goto-msg found) | ||
| 634 | (error "No %s message with same subject" | ||
| 635 | (if forward "following" "previous"))))) | ||
| 543 | 636 | ||
| 544 | (defun pmail-summary-previous-same-subject (n) | 637 | (defun pmail-summary-previous-same-subject (n) |
| 545 | "Go to the previous message in the summary having the same subject. | 638 | "Go to the previous message in the summary having the same subject. |
| @@ -547,7 +640,6 @@ With prefix argument N, do this N times. | |||
| 547 | If N is negative, go forwards instead." | 640 | If N is negative, go forwards instead." |
| 548 | (interactive "p") | 641 | (interactive "p") |
| 549 | (pmail-summary-next-same-subject (- n))) | 642 | (pmail-summary-next-same-subject (- n))) |
| 550 | |||
| 551 | 643 | ||
| 552 | ;; Delete and undelete summary commands. | 644 | ;; Delete and undelete summary commands. |
| 553 | 645 | ||
| @@ -570,11 +662,11 @@ a negative argument means to delete and move backward." | |||
| 570 | (save-excursion (beginning-of-line) | 662 | (save-excursion (beginning-of-line) |
| 571 | (looking-at " *[0-9]+D"))) | 663 | (looking-at " *[0-9]+D"))) |
| 572 | (forward-line (if backward -1 1))) | 664 | (forward-line (if backward -1 1))) |
| 665 | ;; It looks ugly to move to the empty line at end of buffer. | ||
| 666 | (and (eobp) (not backward) | ||
| 667 | (forward-line -1)) | ||
| 573 | (setq count | 668 | (setq count |
| 574 | (if (> count 0) (1- count) (1+ count)))) | 669 | (if (> count 0) (1- count) (1+ count)))))) |
| 575 | ;; Update the summary buffer current message counter and show the | ||
| 576 | ;; message in the Pmail buffer. | ||
| 577 | (pmail-summary-goto-msg (pmail-summary-get-message-at-point)))) | ||
| 578 | 670 | ||
| 579 | (defun pmail-summary-delete-backward (&optional count) | 671 | (defun pmail-summary-delete-backward (&optional count) |
| 580 | "Delete this message and move to previous nondeleted one. | 672 | "Delete this message and move to previous nondeleted one. |
| @@ -586,7 +678,7 @@ a negative argument means to delete and move forward." | |||
| 586 | 678 | ||
| 587 | (defun pmail-summary-mark-deleted (&optional n undel) | 679 | (defun pmail-summary-mark-deleted (&optional n undel) |
| 588 | ;; Since third arg is t, this only alters the summary, not the Pmail buf. | 680 | ;; Since third arg is t, this only alters the summary, not the Pmail buf. |
| 589 | (and n (pmail-summary-goto-msg n t)) | 681 | (and n (pmail-summary-goto-msg n t t)) |
| 590 | (or (eobp) | 682 | (or (eobp) |
| 591 | (not (overlay-get pmail-summary-overlay 'face)) | 683 | (not (overlay-get pmail-summary-overlay 'face)) |
| 592 | (let ((buffer-read-only nil)) | 684 | (let ((buffer-read-only nil)) |
| @@ -603,9 +695,11 @@ a negative argument means to delete and move forward." | |||
| 603 | (pmail-summary-mark-deleted n t)) | 695 | (pmail-summary-mark-deleted n t)) |
| 604 | 696 | ||
| 605 | (defun pmail-summary-deleted-p (&optional n) | 697 | (defun pmail-summary-deleted-p (&optional n) |
| 606 | (unless n (setq n pmail-current-message)) | 698 | (save-excursion |
| 607 | (with-current-buffer pmail-buffer | 699 | (and n (pmail-summary-goto-msg n nil t)) |
| 608 | (pmail-desc-deleted-p n))) | 700 | (skip-chars-forward " ") |
| 701 | (skip-chars-forward "[0-9]") | ||
| 702 | (looking-at "D"))) | ||
| 609 | 703 | ||
| 610 | (defun pmail-summary-undelete (&optional arg) | 704 | (defun pmail-summary-undelete (&optional arg) |
| 611 | "Undelete current message. | 705 | "Undelete current message. |
| @@ -615,40 +709,44 @@ Optional prefix ARG means undelete ARG previous messages." | |||
| 615 | (pmail-summary-undelete-many arg) | 709 | (pmail-summary-undelete-many arg) |
| 616 | (let ((buffer-read-only nil) | 710 | (let ((buffer-read-only nil) |
| 617 | (opoint (point))) | 711 | (opoint (point))) |
| 618 | (goto-char (line-end-position)) | 712 | (end-of-line) |
| 619 | (if (not (re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t)) | 713 | (cond ((re-search-backward "\\(^ *[0-9]*\\)\\(D\\)" nil t) |
| 620 | (goto-char opoint) | 714 | (replace-match "\\1 ") |
| 621 | (replace-match "\\1 ") | 715 | (pmail-summary-goto-msg) |
| 622 | (pmail-summary-goto-msg) | 716 | (if pmail-enable-mime |
| 623 | (if pmail-enable-mime | 717 | (set-buffer pmail-buffer) |
| 624 | (set-buffer pmail-buffer) | 718 | (pop-to-buffer pmail-buffer)) |
| 625 | (pop-to-buffer pmail-buffer)) | 719 | (and (pmail-message-deleted-p pmail-current-message) |
| 626 | (when (pmail-message-deleted-p pmail-current-message) | 720 | (pmail-undelete-previous-message)) |
| 627 | (pmail-undelete-previous-message)) | 721 | (if pmail-enable-mime |
| 628 | (when pmail-enable-mime | 722 | (pop-to-buffer pmail-buffer)) |
| 629 | (pop-to-buffer pmail-view-buffer)) | 723 | (pop-to-buffer pmail-summary-buffer)) |
| 630 | (pop-to-buffer pmail-summary-buffer))))) | 724 | (t (goto-char opoint)))))) |
| 631 | 725 | ||
| 632 | (defun pmail-summary-undelete-many (&optional n) | 726 | (defun pmail-summary-undelete-many (&optional n) |
| 633 | "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs." | 727 | "Undelete all deleted msgs, optional prefix arg N means undelete N prev msgs." |
| 634 | (interactive "P") | 728 | (interactive "P") |
| 635 | (with-current-buffer pmail-buffer | 729 | (save-excursion |
| 730 | (set-buffer pmail-buffer) | ||
| 636 | (let* ((init-msg (if n pmail-current-message pmail-total-messages)) | 731 | (let* ((init-msg (if n pmail-current-message pmail-total-messages)) |
| 637 | (pmail-current-message init-msg) | 732 | (pmail-current-message init-msg) |
| 638 | (n (or n pmail-total-messages)) | 733 | (n (or n pmail-total-messages)) |
| 639 | (msgs-undeled 0)) | 734 | (msgs-undeled 0)) |
| 640 | (while (and (> pmail-current-message 0) (< msgs-undeled n)) | 735 | (while (and (> pmail-current-message 0) |
| 641 | (when (pmail-message-deleted-p pmail-current-message) | 736 | (< msgs-undeled n)) |
| 642 | (pmail-set-attribute "deleted" nil) | 737 | (if (pmail-message-deleted-p pmail-current-message) |
| 643 | (setq msgs-undeled (1+ msgs-undeled))) | 738 | (progn (pmail-set-attribute "deleted" nil) |
| 739 | (setq msgs-undeled (1+ msgs-undeled)))) | ||
| 644 | (setq pmail-current-message (1- pmail-current-message))) | 740 | (setq pmail-current-message (1- pmail-current-message))) |
| 645 | (with-current-buffer pmail-summary-buffer | 741 | (set-buffer pmail-summary-buffer) |
| 646 | (setq pmail-current-message init-msg msgs-undeled 0) | 742 | (setq pmail-current-message init-msg msgs-undeled 0) |
| 647 | (while (and (> pmail-current-message 0) (< msgs-undeled n)) | 743 | (while (and (> pmail-current-message 0) |
| 648 | (when (pmail-summary-deleted-p pmail-current-message) | 744 | (< msgs-undeled n)) |
| 649 | (pmail-summary-mark-undeleted pmail-current-message) | 745 | (if (pmail-summary-deleted-p pmail-current-message) |
| 650 | (setq msgs-undeled (1+ msgs-undeled))) | 746 | (progn (pmail-summary-mark-undeleted pmail-current-message) |
| 651 | (setq pmail-current-message (1- pmail-current-message))))))) | 747 | (setq msgs-undeled (1+ msgs-undeled)))) |
| 748 | (setq pmail-current-message (1- pmail-current-message)))) | ||
| 749 | (pmail-summary-goto-msg))) | ||
| 652 | 750 | ||
| 653 | ;; Pmail Summary mode is suitable only for specially formatted data. | 751 | ;; Pmail Summary mode is suitable only for specially formatted data. |
| 654 | (put 'pmail-summary-mode 'mode-class 'special) | 752 | (put 'pmail-summary-mode 'mode-class 'special) |
| @@ -667,22 +765,6 @@ These additional commands exist: | |||
| 667 | \\[pmail-summary-undelete-many] Undelete all or prefix arg deleted messages. | 765 | \\[pmail-summary-undelete-many] Undelete all or prefix arg deleted messages. |
| 668 | \\[pmail-summary-wipe] Delete the summary and go to the Pmail buffer. | 766 | \\[pmail-summary-wipe] Delete the summary and go to the Pmail buffer. |
| 669 | 767 | ||
| 670 | Commands for filtering the summary: | ||
| 671 | |||
| 672 | \\[pmail-summary-by-labels] Filter by label. | ||
| 673 | \\[pmail-summary-by-topic] Filter by Subject. | ||
| 674 | Filter by the entire message (header and body) if given a | ||
| 675 | prefix argument. | ||
| 676 | \\[pmail-summary-by-senders] Filter by From field. | ||
| 677 | \\[pmail-summary-by-recipients] Filter by To, From, and Cc fields. | ||
| 678 | Filter by To and From only if given a prefix argument. | ||
| 679 | |||
| 680 | The commands listed above take comma-separated lists of regular | ||
| 681 | expressions. | ||
| 682 | |||
| 683 | \\[pmail-summary-by-regexp] Filter by any header line. | ||
| 684 | \\[pmail-summary] Restore the default summary. | ||
| 685 | |||
| 686 | Commands for sorting the summary: | 768 | Commands for sorting the summary: |
| 687 | 769 | ||
| 688 | \\[pmail-summary-sort-by-date] Sort by date. | 770 | \\[pmail-summary-sort-by-date] Sort by date. |
| @@ -700,7 +782,6 @@ Commands for sorting the summary: | |||
| 700 | (setq buffer-read-only t) | 782 | (setq buffer-read-only t) |
| 701 | (set-syntax-table text-mode-syntax-table) | 783 | (set-syntax-table text-mode-syntax-table) |
| 702 | (make-local-variable 'pmail-buffer) | 784 | (make-local-variable 'pmail-buffer) |
| 703 | (make-local-variable 'pmail-view-buffer) | ||
| 704 | (make-local-variable 'pmail-total-messages) | 785 | (make-local-variable 'pmail-total-messages) |
| 705 | (make-local-variable 'pmail-current-message) | 786 | (make-local-variable 'pmail-current-message) |
| 706 | (setq pmail-current-message nil) | 787 | (setq pmail-current-message nil) |
| @@ -730,101 +811,289 @@ the `unseen' attribute from that message, it sets this flag | |||
| 730 | so that if the next motion between messages is in the same Incremental | 811 | so that if the next motion between messages is in the same Incremental |
| 731 | Search, the `unseen' attribute is restored.") | 812 | Search, the `unseen' attribute is restored.") |
| 732 | 813 | ||
| 814 | ;; Show in Pmail the message described by the summary line that point is on, | ||
| 815 | ;; but only if the Pmail buffer is already visible. | ||
| 816 | ;; This is a post-command-hook in summary buffers. | ||
| 733 | (defun pmail-summary-pmail-update () | 817 | (defun pmail-summary-pmail-update () |
| 734 | "Update the Pmail summary buffer. | ||
| 735 | Put the cursor on the beginning of the line containing the | ||
| 736 | current message and highlight the buffer. Show in Pmail the | ||
| 737 | message described by the summary line that point is on, but only | ||
| 738 | if the Pmail buffer is already visible. This is on | ||
| 739 | `post-command-hook' in summary buffers." | ||
| 740 | (let (buffer-read-only) | 818 | (let (buffer-read-only) |
| 741 | (save-excursion | 819 | (save-excursion |
| 742 | ;; If at end of buffer, pretend we are on the last text line. | 820 | ;; If at end of buffer, pretend we are on the last text line. |
| 743 | (when (eobp) | 821 | (if (eobp) |
| 744 | (forward-line -1)) | 822 | (forward-line -1)) |
| 745 | ;; Determine the message number corresponding to line point is on. | ||
| 746 | (beginning-of-line) | 823 | (beginning-of-line) |
| 747 | (skip-chars-forward " ") | 824 | (skip-chars-forward " ") |
| 748 | (let ((msg-num (string-to-number (buffer-substring | 825 | (let ((msg-num (string-to-number (buffer-substring |
| 749 | (point) | 826 | (point) |
| 750 | (progn (skip-chars-forward "0-9") | 827 | (progn (skip-chars-forward "0-9") |
| 751 | (point)))))) | 828 | (point)))))) |
| 752 | ;; Always leave `unseen' removed if we get out of isearch mode. | 829 | ;; Always leave `unseen' removed |
| 753 | ;; Don't let a subsequent isearch restore `unseen'. | 830 | ;; if we get out of isearch mode. |
| 754 | (when (not isearch-mode) | 831 | ;; Don't let a subsequent isearch restore that `unseen'. |
| 755 | (setq pmail-summary-put-back-unseen nil)) | 832 | (if (not isearch-mode) |
| 833 | (setq pmail-summary-put-back-unseen nil)) | ||
| 834 | |||
| 756 | (or (eq pmail-current-message msg-num) | 835 | (or (eq pmail-current-message msg-num) |
| 757 | (let ((window (get-buffer-window pmail-view-buffer t)) | 836 | (let ((window (get-buffer-window pmail-buffer t)) |
| 758 | (owin (selected-window))) | 837 | (owin (selected-window))) |
| 759 | (if isearch-mode | 838 | (if isearch-mode |
| 760 | (save-excursion | 839 | (save-excursion |
| 761 | (set-buffer pmail-buffer) | 840 | (set-buffer pmail-buffer) |
| 762 | ;; If we first saw the previous message in this | 841 | ;; If we first saw the previous message in this search, |
| 763 | ;; search, and we have gone to a different message | 842 | ;; and we have gone to a different message while searching, |
| 764 | ;; while searching, put back `unseen' on the former | 843 | ;; put back `unseen' on the former one. |
| 765 | ;; one. | ||
| 766 | (if pmail-summary-put-back-unseen | 844 | (if pmail-summary-put-back-unseen |
| 767 | (pmail-set-attribute "unseen" t | 845 | (pmail-set-attribute "unseen" t |
| 768 | pmail-current-message)) | 846 | pmail-current-message)) |
| 769 | ;; Arrange to do that later, for the new current message, | 847 | ;; Arrange to do that later, for the new current message, |
| 770 | ;; if it still has `unseen'. | 848 | ;; if it still has `unseen'. |
| 771 | (setq pmail-summary-put-back-unseen | 849 | (setq pmail-summary-put-back-unseen |
| 772 | (member "unseen" (pmail-desc-get-keywords msg-num)))) | 850 | (pmail-message-attr-p msg-num pmail-unseen-attr-index))) |
| 773 | (setq pmail-summary-put-back-unseen nil)) | 851 | (setq pmail-summary-put-back-unseen nil)) |
| 852 | |||
| 774 | ;; Go to the desired message. | 853 | ;; Go to the desired message. |
| 775 | (setq pmail-current-message msg-num) | 854 | (setq pmail-current-message msg-num) |
| 855 | |||
| 776 | ;; Update the summary to show the message has been seen. | 856 | ;; Update the summary to show the message has been seen. |
| 777 | (when (= (following-char) ?-) | 857 | (if (= (following-char) ?-) |
| 778 | (delete-char 1) | 858 | (progn |
| 779 | (insert " ")) | 859 | (delete-char 1) |
| 860 | (insert " "))) | ||
| 861 | |||
| 780 | (if window | 862 | (if window |
| 781 | ;; Using save-window-excursion would cause the new value | 863 | ;; Using save-window-excursion would cause the new value |
| 782 | ;; of point to get lost. | 864 | ;; of point to get lost. |
| 783 | (unwind-protect | 865 | (unwind-protect |
| 784 | (progn | 866 | (progn |
| 785 | (select-window window) | 867 | (select-window window) |
| 786 | (pmail-show-message msg-num t)) | 868 | (pmail-show-message-maybe msg-num t)) |
| 787 | (select-window owin)) | 869 | (select-window owin)) |
| 788 | (when (buffer-name pmail-buffer) | 870 | (if (buffer-name pmail-buffer) |
| 789 | (save-excursion | 871 | (save-excursion |
| 790 | (set-buffer pmail-buffer) | 872 | (set-buffer pmail-buffer) |
| 791 | (pmail-show-message msg-num t)))))) | 873 | (pmail-show-message-maybe msg-num t)))))) |
| 792 | (pmail-summary-update-highlight nil))))) | 874 | (pmail-summary-update-highlight nil))))) |
| 875 | |||
| 876 | (defun pmail-summary-save-buffer () | ||
| 877 | "Save the buffer associated with this PMAIL summary." | ||
| 878 | (interactive) | ||
| 879 | (save-window-excursion | ||
| 880 | (save-excursion | ||
| 881 | (switch-to-buffer pmail-buffer) | ||
| 882 | (save-buffer)))) | ||
| 883 | |||
| 884 | |||
| 885 | (if pmail-summary-mode-map | ||
| 886 | nil | ||
| 887 | (setq pmail-summary-mode-map (make-keymap)) | ||
| 888 | (suppress-keymap pmail-summary-mode-map) | ||
| 889 | |||
| 890 | (define-key pmail-summary-mode-map [mouse-2] 'pmail-summary-mouse-goto-message) | ||
| 891 | (define-key pmail-summary-mode-map "a" 'pmail-summary-add-label) | ||
| 892 | (define-key pmail-summary-mode-map "b" 'pmail-summary-bury) | ||
| 893 | (define-key pmail-summary-mode-map "c" 'pmail-summary-continue) | ||
| 894 | (define-key pmail-summary-mode-map "d" 'pmail-summary-delete-forward) | ||
| 895 | (define-key pmail-summary-mode-map "\C-d" 'pmail-summary-delete-backward) | ||
| 896 | (define-key pmail-summary-mode-map "e" 'pmail-summary-edit-current-message) | ||
| 897 | (define-key pmail-summary-mode-map "f" 'pmail-summary-forward) | ||
| 898 | (define-key pmail-summary-mode-map "g" 'pmail-summary-get-new-mail) | ||
| 899 | (define-key pmail-summary-mode-map "h" 'pmail-summary) | ||
| 900 | (define-key pmail-summary-mode-map "i" 'pmail-summary-input) | ||
| 901 | (define-key pmail-summary-mode-map "j" 'pmail-summary-goto-msg) | ||
| 902 | (define-key pmail-summary-mode-map "\C-m" 'pmail-summary-goto-msg) | ||
| 903 | (define-key pmail-summary-mode-map "k" 'pmail-summary-kill-label) | ||
| 904 | (define-key pmail-summary-mode-map "l" 'pmail-summary-by-labels) | ||
| 905 | (define-key pmail-summary-mode-map "\e\C-h" 'pmail-summary) | ||
| 906 | (define-key pmail-summary-mode-map "\e\C-l" 'pmail-summary-by-labels) | ||
| 907 | (define-key pmail-summary-mode-map "\e\C-r" 'pmail-summary-by-recipients) | ||
| 908 | (define-key pmail-summary-mode-map "\e\C-s" 'pmail-summary-by-regexp) | ||
| 909 | (define-key pmail-summary-mode-map "\e\C-t" 'pmail-summary-by-topic) | ||
| 910 | (define-key pmail-summary-mode-map "m" 'pmail-summary-mail) | ||
| 911 | (define-key pmail-summary-mode-map "\M-m" 'pmail-summary-retry-failure) | ||
| 912 | (define-key pmail-summary-mode-map "n" 'pmail-summary-next-msg) | ||
| 913 | (define-key pmail-summary-mode-map "\en" 'pmail-summary-next-all) | ||
| 914 | (define-key pmail-summary-mode-map "\e\C-n" 'pmail-summary-next-labeled-message) | ||
| 915 | (define-key pmail-summary-mode-map "o" 'pmail-summary-output-to-pmail-file) | ||
| 916 | (define-key pmail-summary-mode-map "\C-o" 'pmail-summary-output) | ||
| 917 | (define-key pmail-summary-mode-map "p" 'pmail-summary-previous-msg) | ||
| 918 | (define-key pmail-summary-mode-map "\ep" 'pmail-summary-previous-all) | ||
| 919 | (define-key pmail-summary-mode-map "\e\C-p" 'pmail-summary-previous-labeled-message) | ||
| 920 | (define-key pmail-summary-mode-map "q" 'pmail-summary-quit) | ||
| 921 | (define-key pmail-summary-mode-map "Q" 'pmail-summary-wipe) | ||
| 922 | (define-key pmail-summary-mode-map "r" 'pmail-summary-reply) | ||
| 923 | (define-key pmail-summary-mode-map "s" 'pmail-summary-expunge-and-save) | ||
| 924 | (define-key pmail-summary-mode-map "\es" 'pmail-summary-search) | ||
| 925 | (define-key pmail-summary-mode-map "t" 'pmail-summary-toggle-header) | ||
| 926 | (define-key pmail-summary-mode-map "u" 'pmail-summary-undelete) | ||
| 927 | (define-key pmail-summary-mode-map "\M-u" 'pmail-summary-undelete-many) | ||
| 928 | (define-key pmail-summary-mode-map "x" 'pmail-summary-expunge) | ||
| 929 | (define-key pmail-summary-mode-map "w" 'pmail-summary-output-body) | ||
| 930 | (define-key pmail-summary-mode-map "." 'pmail-summary-beginning-of-message) | ||
| 931 | (define-key pmail-summary-mode-map "/" 'pmail-summary-end-of-message) | ||
| 932 | (define-key pmail-summary-mode-map "<" 'pmail-summary-first-message) | ||
| 933 | (define-key pmail-summary-mode-map ">" 'pmail-summary-last-message) | ||
| 934 | (define-key pmail-summary-mode-map " " 'pmail-summary-scroll-msg-up) | ||
| 935 | (define-key pmail-summary-mode-map "\177" 'pmail-summary-scroll-msg-down) | ||
| 936 | (define-key pmail-summary-mode-map "?" 'describe-mode) | ||
| 937 | (define-key pmail-summary-mode-map "\C-c\C-n" 'pmail-summary-next-same-subject) | ||
| 938 | (define-key pmail-summary-mode-map "\C-c\C-p" 'pmail-summary-previous-same-subject) | ||
| 939 | (define-key pmail-summary-mode-map "\C-c\C-s\C-d" | ||
| 940 | 'pmail-summary-sort-by-date) | ||
| 941 | (define-key pmail-summary-mode-map "\C-c\C-s\C-s" | ||
| 942 | 'pmail-summary-sort-by-subject) | ||
| 943 | (define-key pmail-summary-mode-map "\C-c\C-s\C-a" | ||
| 944 | 'pmail-summary-sort-by-author) | ||
| 945 | (define-key pmail-summary-mode-map "\C-c\C-s\C-r" | ||
| 946 | 'pmail-summary-sort-by-recipient) | ||
| 947 | (define-key pmail-summary-mode-map "\C-c\C-s\C-c" | ||
| 948 | 'pmail-summary-sort-by-correspondent) | ||
| 949 | (define-key pmail-summary-mode-map "\C-c\C-s\C-l" | ||
| 950 | 'pmail-summary-sort-by-lines) | ||
| 951 | (define-key pmail-summary-mode-map "\C-c\C-s\C-k" | ||
| 952 | 'pmail-summary-sort-by-labels) | ||
| 953 | (define-key pmail-summary-mode-map "\C-x\C-s" 'pmail-summary-save-buffer) | ||
| 954 | ) | ||
| 955 | |||
| 956 | ;;; Menu bar bindings. | ||
| 957 | |||
| 958 | (define-key pmail-summary-mode-map [menu-bar] (make-sparse-keymap)) | ||
| 959 | |||
| 960 | (define-key pmail-summary-mode-map [menu-bar classify] | ||
| 961 | (cons "Classify" (make-sparse-keymap "Classify"))) | ||
| 962 | |||
| 963 | (define-key pmail-summary-mode-map [menu-bar classify output-menu] | ||
| 964 | '("Output (Pmail Menu)..." . pmail-summary-output-menu)) | ||
| 965 | |||
| 966 | (define-key pmail-summary-mode-map [menu-bar classify input-menu] | ||
| 967 | '("Input Pmail File (menu)..." . pmail-input-menu)) | ||
| 968 | |||
| 969 | (define-key pmail-summary-mode-map [menu-bar classify input-menu] | ||
| 970 | '(nil)) | ||
| 971 | |||
| 972 | (define-key pmail-summary-mode-map [menu-bar classify output-menu] | ||
| 973 | '(nil)) | ||
| 974 | |||
| 975 | (define-key pmail-summary-mode-map [menu-bar classify output-body] | ||
| 976 | '("Output (body)..." . pmail-summary-output-body)) | ||
| 977 | |||
| 978 | (define-key pmail-summary-mode-map [menu-bar classify output-inbox] | ||
| 979 | '("Output (inbox)..." . pmail-summary-output)) | ||
| 980 | |||
| 981 | (define-key pmail-summary-mode-map [menu-bar classify output] | ||
| 982 | '("Output (Pmail)..." . pmail-summary-output-to-pmail-file)) | ||
| 983 | |||
| 984 | (define-key pmail-summary-mode-map [menu-bar classify kill-label] | ||
| 985 | '("Kill Label..." . pmail-summary-kill-label)) | ||
| 986 | |||
| 987 | (define-key pmail-summary-mode-map [menu-bar classify add-label] | ||
| 988 | '("Add Label..." . pmail-summary-add-label)) | ||
| 989 | |||
| 990 | (define-key pmail-summary-mode-map [menu-bar summary] | ||
| 991 | (cons "Summary" (make-sparse-keymap "Summary"))) | ||
| 992 | |||
| 993 | (define-key pmail-summary-mode-map [menu-bar summary senders] | ||
| 994 | '("By Senders..." . pmail-summary-by-senders)) | ||
| 995 | |||
| 996 | (define-key pmail-summary-mode-map [menu-bar summary labels] | ||
| 997 | '("By Labels..." . pmail-summary-by-labels)) | ||
| 998 | |||
| 999 | (define-key pmail-summary-mode-map [menu-bar summary recipients] | ||
| 1000 | '("By Recipients..." . pmail-summary-by-recipients)) | ||
| 1001 | |||
| 1002 | (define-key pmail-summary-mode-map [menu-bar summary topic] | ||
| 1003 | '("By Topic..." . pmail-summary-by-topic)) | ||
| 1004 | |||
| 1005 | (define-key pmail-summary-mode-map [menu-bar summary regexp] | ||
| 1006 | '("By Regexp..." . pmail-summary-by-regexp)) | ||
| 1007 | |||
| 1008 | (define-key pmail-summary-mode-map [menu-bar summary all] | ||
| 1009 | '("All" . pmail-summary)) | ||
| 1010 | |||
| 1011 | (define-key pmail-summary-mode-map [menu-bar mail] | ||
| 1012 | (cons "Mail" (make-sparse-keymap "Mail"))) | ||
| 1013 | |||
| 1014 | (define-key pmail-summary-mode-map [menu-bar mail pmail-summary-get-new-mail] | ||
| 1015 | '("Get New Mail" . pmail-summary-get-new-mail)) | ||
| 1016 | |||
| 1017 | (define-key pmail-summary-mode-map [menu-bar mail lambda] | ||
| 1018 | '("----")) | ||
| 1019 | |||
| 1020 | (define-key pmail-summary-mode-map [menu-bar mail continue] | ||
| 1021 | '("Continue" . pmail-summary-continue)) | ||
| 1022 | |||
| 1023 | (define-key pmail-summary-mode-map [menu-bar mail resend] | ||
| 1024 | '("Re-send..." . pmail-summary-resend)) | ||
| 1025 | |||
| 1026 | (define-key pmail-summary-mode-map [menu-bar mail forward] | ||
| 1027 | '("Forward" . pmail-summary-forward)) | ||
| 1028 | |||
| 1029 | (define-key pmail-summary-mode-map [menu-bar mail retry] | ||
| 1030 | '("Retry" . pmail-summary-retry-failure)) | ||
| 1031 | |||
| 1032 | (define-key pmail-summary-mode-map [menu-bar mail reply] | ||
| 1033 | '("Reply" . pmail-summary-reply)) | ||
| 1034 | |||
| 1035 | (define-key pmail-summary-mode-map [menu-bar mail mail] | ||
| 1036 | '("Mail" . pmail-summary-mail)) | ||
| 1037 | |||
| 1038 | (define-key pmail-summary-mode-map [menu-bar delete] | ||
| 1039 | (cons "Delete" (make-sparse-keymap "Delete"))) | ||
| 1040 | |||
| 1041 | (define-key pmail-summary-mode-map [menu-bar delete expunge/save] | ||
| 1042 | '("Expunge/Save" . pmail-summary-expunge-and-save)) | ||
| 1043 | |||
| 1044 | (define-key pmail-summary-mode-map [menu-bar delete expunge] | ||
| 1045 | '("Expunge" . pmail-summary-expunge)) | ||
| 1046 | |||
| 1047 | (define-key pmail-summary-mode-map [menu-bar delete undelete] | ||
| 1048 | '("Undelete" . pmail-summary-undelete)) | ||
| 1049 | |||
| 1050 | (define-key pmail-summary-mode-map [menu-bar delete delete] | ||
| 1051 | '("Delete" . pmail-summary-delete-forward)) | ||
| 1052 | |||
| 1053 | (define-key pmail-summary-mode-map [menu-bar move] | ||
| 1054 | (cons "Move" (make-sparse-keymap "Move"))) | ||
| 1055 | |||
| 1056 | (define-key pmail-summary-mode-map [menu-bar move search-back] | ||
| 1057 | '("Search Back..." . pmail-summary-search-backward)) | ||
| 1058 | |||
| 1059 | (define-key pmail-summary-mode-map [menu-bar move search] | ||
| 1060 | '("Search..." . pmail-summary-search)) | ||
| 1061 | |||
| 1062 | (define-key pmail-summary-mode-map [menu-bar move previous] | ||
| 1063 | '("Previous Nondeleted" . pmail-summary-previous-msg)) | ||
| 1064 | |||
| 1065 | (define-key pmail-summary-mode-map [menu-bar move next] | ||
| 1066 | '("Next Nondeleted" . pmail-summary-next-msg)) | ||
| 1067 | |||
| 1068 | (define-key pmail-summary-mode-map [menu-bar move last] | ||
| 1069 | '("Last" . pmail-summary-last-message)) | ||
| 1070 | |||
| 1071 | (define-key pmail-summary-mode-map [menu-bar move first] | ||
| 1072 | '("First" . pmail-summary-first-message)) | ||
| 1073 | |||
| 1074 | (define-key pmail-summary-mode-map [menu-bar move previous] | ||
| 1075 | '("Previous" . pmail-summary-previous-all)) | ||
| 1076 | |||
| 1077 | (define-key pmail-summary-mode-map [menu-bar move next] | ||
| 1078 | '("Next" . pmail-summary-next-all)) | ||
| 793 | 1079 | ||
| 794 | (defun pmail-summary-mouse-goto-message (event) | 1080 | (defun pmail-summary-mouse-goto-message (event) |
| 795 | "Select the message whose summary line you click on." | 1081 | "Select the message whose summary line you click on." |
| 796 | (interactive "@e") | 1082 | (interactive "@e") |
| 797 | (goto-char (posn-point (event-end event))) | 1083 | (goto-char (posn-point (event-end event))) |
| 798 | (setq pmail-current-message (pmail-summary-get-message-at-point)) | 1084 | (pmail-summary-goto-msg)) |
| 799 | (pmail-summary-pmail-update)) | ||
| 800 | |||
| 801 | (defun pmail-summary-get-message-at-point () | ||
| 802 | "Return the message number corresponding to the line containing point. | ||
| 803 | If the summary buffer contains no messages, nil is returned." | ||
| 804 | (save-excursion | ||
| 805 | ;; Position point at the beginning of a line. | ||
| 806 | (if (eobp) | ||
| 807 | (forward-line -1) | ||
| 808 | (forward-line 0)) | ||
| 809 | ;; Parse the message number. | ||
| 810 | (string-to-number | ||
| 811 | (buffer-substring (point) (min (point-max) (+ 6 (point))))))) | ||
| 812 | 1085 | ||
| 813 | (defun pmail-summary-goto-msg (&optional n nowarn skip-pmail) | 1086 | (defun pmail-summary-goto-msg (&optional n nowarn skip-pmail) |
| 814 | "Go to message N in the summary buffer and the Pmail buffer. | 1087 | "Go to message N in the summary buffer and the Pmail buffer. |
| 815 | If N is nil, use the message corresponding to point in the summary | 1088 | If N is nil, use the message corresponding to point in the summary |
| 816 | buffer and move to that message in the Pmail buffer. | 1089 | and move to that message in the Pmail buffer. |
| 817 | 1090 | ||
| 818 | If NOWARN, don't say anything if N is out of range. | 1091 | If NOWARN, don't say anything if N is out of range. |
| 819 | If SKIP-PMAIL, don't do anything to the Pmail buffer." | 1092 | If SKIP-PMAIL, don't do anything to the Pmail buffer." |
| 820 | (interactive "P") | 1093 | (interactive "P") |
| 821 | (if (consp n) (setq n (prefix-numeric-value n))) | 1094 | (if (consp n) (setq n (prefix-numeric-value n))) |
| 822 | ;; Do the end of buffer adjustment. | ||
| 823 | (if (eobp) (forward-line -1)) | 1095 | (if (eobp) (forward-line -1)) |
| 824 | (beginning-of-line) | 1096 | (beginning-of-line) |
| 825 | ;; Set N to the current message unless it was already set by the | ||
| 826 | ;; caller. | ||
| 827 | (unless n (setq n (pmail-summary-get-message-at-point))) | ||
| 828 | (let* ((obuf (current-buffer)) | 1097 | (let* ((obuf (current-buffer)) |
| 829 | (buf pmail-buffer) | 1098 | (buf pmail-buffer) |
| 830 | (cur (point)) | 1099 | (cur (point)) |
| @@ -832,25 +1101,27 @@ If SKIP-PMAIL, don't do anything to the Pmail buffer." | |||
| 832 | (curmsg (string-to-number | 1101 | (curmsg (string-to-number |
| 833 | (buffer-substring (point) | 1102 | (buffer-substring (point) |
| 834 | (min (point-max) (+ 6 (point)))))) | 1103 | (min (point-max) (+ 6 (point)))))) |
| 835 | (total (with-current-buffer buf | 1104 | (total (save-excursion (set-buffer buf) pmail-total-messages))) |
| 836 | pmail-total-messages))) | 1105 | ;; If message number N was specified, find that message's line |
| 837 | ;; Do a validity check on N. If it is valid then set the current | 1106 | ;; or set message-not-found. |
| 838 | ;; summary message to N. `pmail-summary-pmail-update' will then | 1107 | ;; If N wasn't specified or that message can't be found. |
| 839 | ;; actually move point to the selected message. | 1108 | ;; set N by default. |
| 840 | (if (< n 1) | 1109 | (if (not n) |
| 841 | (progn (message "No preceding message") | 1110 | (setq n curmsg) |
| 842 | (setq n 1))) | 1111 | (if (< n 1) |
| 843 | (if (and (> n total) | 1112 | (progn (message "No preceding message") |
| 844 | (> total 0)) | 1113 | (setq n 1))) |
| 845 | (progn (message "No following message") | 1114 | (if (and (> n total) |
| 846 | (goto-char (point-max)) | 1115 | (> total 0)) |
| 847 | (pmail-summary-goto-msg nil nowarn skip-pmail))) | 1116 | (progn (message "No following message") |
| 848 | (goto-char (point-min)) | 1117 | (goto-char (point-max)) |
| 849 | (if (not (re-search-forward (format "^%5d[^0-9]" n) nil t)) | 1118 | (pmail-summary-goto-msg nil nowarn skip-pmail))) |
| 850 | (progn (or nowarn (message "Message %d not found" n)) | 1119 | (goto-char (point-min)) |
| 851 | (setq n curmsg) | 1120 | (if (not (re-search-forward (format "^%5d[^0-9]" n) nil t)) |
| 852 | (setq message-not-found t) | 1121 | (progn (or nowarn (message "Message %d not found" n)) |
| 853 | (goto-char cur))) | 1122 | (setq n curmsg) |
| 1123 | (setq message-not-found t) | ||
| 1124 | (goto-char cur)))) | ||
| 854 | (beginning-of-line) | 1125 | (beginning-of-line) |
| 855 | (skip-chars-forward " ") | 1126 | (skip-chars-forward " ") |
| 856 | (skip-chars-forward "0-9") | 1127 | (skip-chars-forward "0-9") |
| @@ -860,10 +1131,8 @@ If SKIP-PMAIL, don't do anything to the Pmail buffer." | |||
| 860 | (insert " ")))) | 1131 | (insert " ")))) |
| 861 | (pmail-summary-update-highlight message-not-found) | 1132 | (pmail-summary-update-highlight message-not-found) |
| 862 | (beginning-of-line) | 1133 | (beginning-of-line) |
| 863 | ;; Determine if the Pmail buffer needs to be processed. | ||
| 864 | (if skip-pmail | 1134 | (if skip-pmail |
| 865 | nil | 1135 | nil |
| 866 | ;; It does. | ||
| 867 | (let ((selwin (selected-window))) | 1136 | (let ((selwin (selected-window))) |
| 868 | (unwind-protect | 1137 | (unwind-protect |
| 869 | (progn (pop-to-buffer buf) | 1138 | (progn (pop-to-buffer buf) |
| @@ -899,7 +1168,7 @@ advance to the next message." | |||
| 899 | (interactive "P") | 1168 | (interactive "P") |
| 900 | (if (eq dist '-) | 1169 | (if (eq dist '-) |
| 901 | (pmail-summary-scroll-msg-down nil) | 1170 | (pmail-summary-scroll-msg-down nil) |
| 902 | (let ((pmail-buffer-window (get-buffer-window pmail-view-buffer))) | 1171 | (let ((pmail-buffer-window (get-buffer-window pmail-buffer))) |
| 903 | (if pmail-buffer-window | 1172 | (if pmail-buffer-window |
| 904 | (if (let ((pmail-summary-window (selected-window))) | 1173 | (if (let ((pmail-summary-window (selected-window))) |
| 905 | (select-window pmail-buffer-window) | 1174 | (select-window pmail-buffer-window) |
| @@ -914,7 +1183,7 @@ advance to the next message." | |||
| 914 | (if (not pmail-summary-scroll-between-messages) | 1183 | (if (not pmail-summary-scroll-between-messages) |
| 915 | (error "End of buffer") | 1184 | (error "End of buffer") |
| 916 | (pmail-summary-next-msg (or dist 1))) | 1185 | (pmail-summary-next-msg (or dist 1))) |
| 917 | (let ((other-window-scroll-buffer pmail-view-buffer)) | 1186 | (let ((other-window-scroll-buffer pmail-buffer)) |
| 918 | (scroll-other-window dist))) | 1187 | (scroll-other-window dist))) |
| 919 | ;; If it isn't visible at all, show the beginning. | 1188 | ;; If it isn't visible at all, show the beginning. |
| 920 | (pmail-summary-beginning-of-message))))) | 1189 | (pmail-summary-beginning-of-message))))) |
| @@ -926,7 +1195,7 @@ move to the previous message." | |||
| 926 | (interactive "P") | 1195 | (interactive "P") |
| 927 | (if (eq dist '-) | 1196 | (if (eq dist '-) |
| 928 | (pmail-summary-scroll-msg-up nil) | 1197 | (pmail-summary-scroll-msg-up nil) |
| 929 | (let ((pmail-buffer-window (get-buffer-window pmail-view-buffer))) | 1198 | (let ((pmail-buffer-window (get-buffer-window pmail-buffer))) |
| 930 | (if pmail-buffer-window | 1199 | (if pmail-buffer-window |
| 931 | (if (let ((pmail-summary-window (selected-window))) | 1200 | (if (let ((pmail-summary-window (selected-window))) |
| 932 | (select-window pmail-buffer-window) | 1201 | (select-window pmail-buffer-window) |
| @@ -940,7 +1209,7 @@ move to the previous message." | |||
| 940 | (if (not pmail-summary-scroll-between-messages) | 1209 | (if (not pmail-summary-scroll-between-messages) |
| 941 | (error "Beginning of buffer") | 1210 | (error "Beginning of buffer") |
| 942 | (pmail-summary-previous-msg (or dist 1))) | 1211 | (pmail-summary-previous-msg (or dist 1))) |
| 943 | (let ((other-window-scroll-buffer pmail-view-buffer)) | 1212 | (let ((other-window-scroll-buffer pmail-buffer)) |
| 944 | (scroll-other-window-down dist))) | 1213 | (scroll-other-window-down dist))) |
| 945 | ;; If it isn't visible at all, show the beginning. | 1214 | ;; If it isn't visible at all, show the beginning. |
| 946 | (pmail-summary-beginning-of-message))))) | 1215 | (pmail-summary-beginning-of-message))))) |
| @@ -960,21 +1229,23 @@ move to the previous message." | |||
| 960 | Position it according to WHERE which can be BEG or END" | 1229 | Position it according to WHERE which can be BEG or END" |
| 961 | (if (and (one-window-p) (not pop-up-frames)) | 1230 | (if (and (one-window-p) (not pop-up-frames)) |
| 962 | ;; If there is just one window, put the summary on the top. | 1231 | ;; If there is just one window, put the summary on the top. |
| 963 | (let ((buffer pmail-view-buffer)) | 1232 | (let ((buffer pmail-buffer)) |
| 964 | (split-window (selected-window) pmail-summary-window-size) | 1233 | (split-window (selected-window) pmail-summary-window-size) |
| 965 | (select-window (frame-first-window)) | 1234 | (select-window (frame-first-window)) |
| 966 | (pop-to-buffer pmail-view-buffer) | 1235 | (pop-to-buffer pmail-buffer) |
| 967 | ;; If pop-to-buffer did not use that window, delete that | 1236 | ;; If pop-to-buffer did not use that window, delete that |
| 968 | ;; window. (This can happen if it uses another frame.) | 1237 | ;; window. (This can happen if it uses another frame.) |
| 969 | (or (eq buffer (window-buffer (next-window (frame-first-window)))) | 1238 | (or (eq buffer (window-buffer (next-window (frame-first-window)))) |
| 970 | (delete-other-windows))) | 1239 | (delete-other-windows))) |
| 971 | (pop-to-buffer pmail-view-buffer)) | 1240 | (pop-to-buffer pmail-buffer)) |
| 972 | (cond ((eq where 'BEG) | 1241 | (cond |
| 973 | (goto-char (point-min)) | 1242 | ((eq where 'BEG) |
| 974 | (search-forward "\n\n")) | 1243 | (goto-char (point-min)) |
| 975 | ((eq where 'END) | 1244 | (search-forward "\n\n")) |
| 976 | (goto-char (point-max)) | 1245 | ((eq where 'END) |
| 977 | (recenter (1- (window-height))))) | 1246 | (goto-char (point-max)) |
| 1247 | (recenter (1- (window-height)))) | ||
| 1248 | ) | ||
| 978 | (pop-to-buffer pmail-summary-buffer)) | 1249 | (pop-to-buffer pmail-summary-buffer)) |
| 979 | 1250 | ||
| 980 | (defun pmail-summary-bury () | 1251 | (defun pmail-summary-bury () |
| @@ -998,7 +1269,7 @@ Position it according to WHERE which can be BEG or END" | |||
| 998 | "Kill and wipe away Pmail summary, remaining within Pmail." | 1269 | "Kill and wipe away Pmail summary, remaining within Pmail." |
| 999 | (interactive) | 1270 | (interactive) |
| 1000 | (save-excursion (set-buffer pmail-buffer) (setq pmail-summary-buffer nil)) | 1271 | (save-excursion (set-buffer pmail-buffer) (setq pmail-summary-buffer nil)) |
| 1001 | (let ((local-pmail-buffer pmail-view-buffer)) | 1272 | (let ((local-pmail-buffer pmail-buffer)) |
| 1002 | (kill-buffer (current-buffer)) | 1273 | (kill-buffer (current-buffer)) |
| 1003 | ;; Delete window if not only one. | 1274 | ;; Delete window if not only one. |
| 1004 | (if (not (eq (selected-window) (next-window nil 'no-minibuf))) | 1275 | (if (not (eq (selected-window) (next-window nil 'no-minibuf))) |
| @@ -1009,17 +1280,23 @@ Position it according to WHERE which can be BEG or END" | |||
| 1009 | (defun pmail-summary-expunge () | 1280 | (defun pmail-summary-expunge () |
| 1010 | "Actually erase all deleted messages and recompute summary headers." | 1281 | "Actually erase all deleted messages and recompute summary headers." |
| 1011 | (interactive) | 1282 | (interactive) |
| 1012 | (set-buffer pmail-buffer) | 1283 | (save-excursion |
| 1013 | (pmail-expunge) | 1284 | (set-buffer pmail-buffer) |
| 1014 | (set-buffer pmail-summary-buffer)) | 1285 | (when (pmail-expunge-confirmed) |
| 1286 | (pmail-only-expunge))) | ||
| 1287 | (pmail-update-summary)) | ||
| 1015 | 1288 | ||
| 1016 | (defun pmail-summary-expunge-and-save () | 1289 | (defun pmail-summary-expunge-and-save () |
| 1017 | "Expunge and save PMAIL file." | 1290 | "Expunge and save PMAIL file." |
| 1018 | (interactive) | 1291 | (interactive) |
| 1019 | (set-buffer pmail-buffer) | 1292 | (save-excursion |
| 1020 | (pmail-expunge) | 1293 | (set-buffer pmail-buffer) |
| 1021 | (save-buffer) | 1294 | (when (pmail-expunge-confirmed) |
| 1022 | (set-buffer pmail-summary-buffer) | 1295 | (pmail-only-expunge))) |
| 1296 | (pmail-update-summary) | ||
| 1297 | (save-excursion | ||
| 1298 | (set-buffer pmail-buffer) | ||
| 1299 | (save-buffer)) | ||
| 1023 | (set-buffer-modified-p nil)) | 1300 | (set-buffer-modified-p nil)) |
| 1024 | 1301 | ||
| 1025 | (defun pmail-summary-get-new-mail (&optional file-name) | 1302 | (defun pmail-summary-get-new-mail (&optional file-name) |
| @@ -1032,14 +1309,15 @@ argument says to read a file name and use that file as the inbox." | |||
| 1032 | (interactive | 1309 | (interactive |
| 1033 | (list (if current-prefix-arg | 1310 | (list (if current-prefix-arg |
| 1034 | (read-file-name "Get new mail from file: ")))) | 1311 | (read-file-name "Get new mail from file: ")))) |
| 1035 | (let (current-message new-mail) | 1312 | (let (msg) |
| 1036 | (with-current-buffer pmail-buffer | 1313 | (save-excursion |
| 1037 | (setq new-mail (pmail-get-new-mail file-name) | 1314 | (set-buffer pmail-buffer) |
| 1038 | current-message pmail-current-message)) | 1315 | (pmail-get-new-mail file-name) |
| 1039 | ;; If new mail was found, display of the correct message was | 1316 | ;; Get the proper new message number. |
| 1040 | ;; done elsewhere. | 1317 | (setq msg pmail-current-message)) |
| 1041 | (unless new-mail | 1318 | ;; Make sure that message is displayed. |
| 1042 | (pmail-summary-goto-msg current-message nil t)))) | 1319 | (or (zerop msg) |
| 1320 | (pmail-summary-goto-msg msg)))) | ||
| 1043 | 1321 | ||
| 1044 | (defun pmail-summary-input (filename) | 1322 | (defun pmail-summary-input (filename) |
| 1045 | "Run Pmail on file FILENAME." | 1323 | "Run Pmail on file FILENAME." |
| @@ -1061,12 +1339,20 @@ argument says to read a file name and use that file as the inbox." | |||
| 1061 | (end-of-buffer)) | 1339 | (end-of-buffer)) |
| 1062 | (forward-line -1)) | 1340 | (forward-line -1)) |
| 1063 | 1341 | ||
| 1064 | (defvar pmail-summary-edit-map | 1342 | (declare-function pmail-abort-edit "pmailedit" ()) |
| 1065 | (let ((map (nconc (make-sparse-keymap) text-mode-map))) | 1343 | (declare-function pmail-cease-edit "pmailedit"()) |
| 1066 | (define-key map "\C-c\C-c" 'pmail-cease-edit) | 1344 | (declare-function pmail-set-label "pmailkwd" (l state &optional n)) |
| 1067 | (define-key map "\C-c\C-]" 'pmail-abort-edit) | 1345 | (declare-function pmail-output-read-file-name "pmailout" ()) |
| 1068 | map) | 1346 | (declare-function pmail-output-read-pmail-file-name "pmailout" ()) |
| 1069 | "Mode map to use when editing the pmail summary.") | 1347 | (declare-function mail-send-and-exit "sendmail" (&optional arg)) |
| 1348 | |||
| 1349 | (defvar pmail-summary-edit-map nil) | ||
| 1350 | (if pmail-summary-edit-map | ||
| 1351 | nil | ||
| 1352 | (setq pmail-summary-edit-map | ||
| 1353 | (nconc (make-sparse-keymap) text-mode-map)) | ||
| 1354 | (define-key pmail-summary-edit-map "\C-c\C-c" 'pmail-cease-edit) | ||
| 1355 | (define-key pmail-summary-edit-map "\C-c\C-]" 'pmail-abort-edit)) | ||
| 1070 | 1356 | ||
| 1071 | (defun pmail-summary-edit-current-message () | 1357 | (defun pmail-summary-edit-current-message () |
| 1072 | "Edit the contents of this message." | 1358 | "Edit the contents of this message." |
| @@ -1155,29 +1441,46 @@ Interactively, empty argument means use same regexp used last time." | |||
| 1155 | (defun pmail-summary-toggle-header () | 1441 | (defun pmail-summary-toggle-header () |
| 1156 | "Show original message header if pruned header currently shown, or vice versa." | 1442 | "Show original message header if pruned header currently shown, or vice versa." |
| 1157 | (interactive) | 1443 | (interactive) |
| 1158 | (with-current-buffer pmail-buffer | 1444 | (save-window-excursion |
| 1159 | (pmail-toggle-header))) | 1445 | (set-buffer pmail-buffer) |
| 1446 | (pmail-toggle-header)) | ||
| 1447 | ;; Inside save-excursion, some changes to point in the PMAIL buffer are lost. | ||
| 1448 | ;; Set point to point-min in the PMAIL buffer, if it is visible. | ||
| 1449 | (let ((window (get-buffer-window pmail-buffer))) | ||
| 1450 | (if window | ||
| 1451 | ;; Using save-window-excursion would lose the new value of point. | ||
| 1452 | (let ((owin (selected-window))) | ||
| 1453 | (unwind-protect | ||
| 1454 | (progn | ||
| 1455 | (select-window window) | ||
| 1456 | (goto-char (point-min))) | ||
| 1457 | (select-window owin)))))) | ||
| 1458 | |||
| 1160 | 1459 | ||
| 1161 | (defun pmail-summary-add-label (label) | 1460 | (defun pmail-summary-add-label (label) |
| 1162 | "Add LABEL to labels associated with current Pmail message. | 1461 | "Add LABEL to labels associated with current Pmail message. |
| 1163 | Completion is performed over known labels when reading." | 1462 | Completion is performed over known labels when reading." |
| 1164 | (interactive (list (with-current-buffer pmail-buffer | 1463 | (interactive (list (save-excursion |
| 1464 | (set-buffer pmail-buffer) | ||
| 1165 | (pmail-read-label "Add label")))) | 1465 | (pmail-read-label "Add label")))) |
| 1166 | (with-current-buffer pmail-buffer | 1466 | (save-excursion |
| 1467 | (set-buffer pmail-buffer) | ||
| 1167 | (pmail-add-label label))) | 1468 | (pmail-add-label label))) |
| 1168 | 1469 | ||
| 1169 | (defun pmail-summary-kill-label (label) | 1470 | (defun pmail-summary-kill-label (label) |
| 1170 | "Remove LABEL from labels associated with current Pmail message. | 1471 | "Remove LABEL from labels associated with current Pmail message. |
| 1171 | Completion is performed over known labels when reading." | 1472 | Completion is performed over known labels when reading." |
| 1172 | (interactive (list (with-current-buffer pmail-buffer | 1473 | (interactive (list (save-excursion |
| 1173 | (pmail-read-label "Kill label" t)))) | 1474 | (set-buffer pmail-buffer) |
| 1174 | (with-current-buffer pmail-buffer | 1475 | (pmail-read-label "Kill label")))) |
| 1175 | (pmail-kill-label label))) | 1476 | (save-excursion |
| 1477 | (set-buffer pmail-buffer) | ||
| 1478 | (pmail-set-label label nil))) | ||
| 1176 | 1479 | ||
| 1177 | ;;;; *** Pmail Summary Mailing Commands *** | 1480 | ;;;; *** Pmail Summary Mailing Commands *** |
| 1178 | 1481 | ||
| 1179 | (defun pmail-summary-override-mail-send-and-exit () | 1482 | (defun pmail-summary-override-mail-send-and-exit () |
| 1180 | "Replace bindings to 'mail-send-and-exit with 'pmail-summary-send-and-exit" | 1483 | "Replace bindings to `mail-send-and-exit' with `pmail-summary-send-and-exit'." |
| 1181 | (use-local-map (copy-keymap (current-local-map))) | 1484 | (use-local-map (copy-keymap (current-local-map))) |
| 1182 | (dolist (key (where-is-internal 'mail-send-and-exit)) | 1485 | (dolist (key (where-is-internal 'mail-send-and-exit)) |
| 1183 | (define-key (current-local-map) key 'pmail-summary-send-and-exit))) | 1486 | (define-key (current-local-map) key 'pmail-summary-send-and-exit))) |
| @@ -1209,10 +1512,10 @@ Normally include CC: to all other recipients of original message; | |||
| 1209 | prefix argument means ignore them. While composing the reply, | 1512 | prefix argument means ignore them. While composing the reply, |
| 1210 | use \\[mail-yank-original] to yank the original message into it." | 1513 | use \\[mail-yank-original] to yank the original message into it." |
| 1211 | (interactive "P") | 1514 | (interactive "P") |
| 1212 | (let ((window (get-buffer-window pmail-view-buffer))) | 1515 | (let ((window (get-buffer-window pmail-buffer))) |
| 1213 | (if window | 1516 | (if window |
| 1214 | (select-window window) | 1517 | (select-window window) |
| 1215 | (set-buffer pmail-view-buffer))) | 1518 | (set-buffer pmail-buffer))) |
| 1216 | (pmail-reply just-sender) | 1519 | (pmail-reply just-sender) |
| 1217 | (pmail-summary-override-mail-send-and-exit)) | 1520 | (pmail-summary-override-mail-send-and-exit)) |
| 1218 | 1521 | ||
| @@ -1256,7 +1559,7 @@ see the documentation of `pmail-resend'." | |||
| 1256 | (set-buffer pmail-buffer))) | 1559 | (set-buffer pmail-buffer))) |
| 1257 | (call-interactively 'pmail-resend))) | 1560 | (call-interactively 'pmail-resend))) |
| 1258 | 1561 | ||
| 1259 | ;;;; Summary output commands. | 1562 | ;; Summary output commands. |
| 1260 | 1563 | ||
| 1261 | (defun pmail-summary-output-to-pmail-file (&optional file-name n) | 1564 | (defun pmail-summary-output-to-pmail-file (&optional file-name n) |
| 1262 | "Append the current message to an Pmail file named FILE-NAME. | 1565 | "Append the current message to an Pmail file named FILE-NAME. |
| @@ -1268,7 +1571,7 @@ A prefix argument N says to output N consecutive messages | |||
| 1268 | starting with the current one. Deleted messages are skipped and don't count." | 1571 | starting with the current one. Deleted messages are skipped and don't count." |
| 1269 | (interactive | 1572 | (interactive |
| 1270 | (progn (require 'pmailout) | 1573 | (progn (require 'pmailout) |
| 1271 | (list (pmail-output-read-file-name) | 1574 | (list (pmail-output-read-pmail-file-name) |
| 1272 | (prefix-numeric-value current-prefix-arg)))) | 1575 | (prefix-numeric-value current-prefix-arg)))) |
| 1273 | (let ((i 0) prev-msg) | 1576 | (let ((i 0) prev-msg) |
| 1274 | (while | 1577 | (while |
| @@ -1415,88 +1718,7 @@ KEYWORDS is a comma-separated list of labels." | |||
| 1415 | (funcall sortfun reverse)) | 1718 | (funcall sortfun reverse)) |
| 1416 | (select-window selwin)))) | 1719 | (select-window selwin)))) |
| 1417 | 1720 | ||
| 1418 | (defun pmail-summary-get-sender (n) | ||
| 1419 | "Return the sender for message N. | ||
| 1420 | If sender matches `pmail-user-mail-address-regexp' or | ||
| 1421 | `user-mail-address', return the to-address instead." | ||
| 1422 | (let ((sender (pmail-desc-get-sender n))) | ||
| 1423 | (if (or (null sender) | ||
| 1424 | (and pmail-user-mail-address-regexp | ||
| 1425 | (string-match pmail-user-mail-address-regexp sender))) | ||
| 1426 | ;; Either no sender known, or it's this user. | ||
| 1427 | (save-restriction | ||
| 1428 | (narrow-to-region (pmail-desc-get-start n) | ||
| 1429 | (pmail-desc-get-end n)) | ||
| 1430 | (concat "to: " (mail-strip-quoted-names | ||
| 1431 | (pmail-header-get-header "to")))) | ||
| 1432 | sender))) | ||
| 1433 | |||
| 1434 | (defun pmail-summary-get-line-count (n) | ||
| 1435 | "Return a string containing the number of lines in message N. | ||
| 1436 | If `pmail-summary-line-count-flag' is nil, return the empty string." | ||
| 1437 | (if pmail-summary-line-count-flag | ||
| 1438 | (let ((lines (pmail-desc-get-line-count n))) | ||
| 1439 | (format (cond ((<= lines 9) " [%d]") | ||
| 1440 | ((<= lines 99) " [%d]") | ||
| 1441 | ((<= lines 999) " [%3d]") | ||
| 1442 | (t "[%d]")) | ||
| 1443 | lines)) | ||
| 1444 | "")) | ||
| 1445 | |||
| 1446 | (defun pmail-summary-get-summary-attributes (n) | ||
| 1447 | "Return the attribute character codes for message N. | ||
| 1448 | `-' means an unseen message, `D' means marked for deletion." | ||
| 1449 | (format "%s%s%s%s%s" | ||
| 1450 | (cond ((pmail-desc-attr-p pmail-desc-unseen-index n) "-") | ||
| 1451 | ((pmail-desc-attr-p pmail-desc-deleted-index n) "D") | ||
| 1452 | (t " ")) | ||
| 1453 | (or (pmail-desc-get-attr-code pmail-desc-answered-index n) " ") | ||
| 1454 | (or (pmail-desc-get-attr-code pmail-desc-filed-index n) " ") | ||
| 1455 | (or (pmail-desc-get-attr-code pmail-desc-edited-index n) " ") | ||
| 1456 | (or (pmail-desc-get-attr-code pmail-desc-stored-index n) " "))) | ||
| 1457 | |||
| 1458 | (defun pmail-summary-get-summary-line (n) | ||
| 1459 | "Return a summary line for message N." | ||
| 1460 | (let (keywords str subj) | ||
| 1461 | (dolist (keyword (pmail-desc-get-keywords n)) | ||
| 1462 | (when (and (pmail-keyword-p keyword) | ||
| 1463 | (not (pmail-attribute-p keyword))) | ||
| 1464 | (setq keywords (cons keyword keywords)))) | ||
| 1465 | (setq keywords (nreverse keywords) | ||
| 1466 | str (if keywords | ||
| 1467 | (concat "{ " (mapconcat 'identity keywords " ") " } ") | ||
| 1468 | "") | ||
| 1469 | subj (replace-regexp-in-string "\\s-+" " " | ||
| 1470 | (pmail-desc-get-subject n))) | ||
| 1471 | (funcall pmail-summary-line-decoder | ||
| 1472 | (format "%5s%s%6s %25.25s%s %s\n" | ||
| 1473 | n | ||
| 1474 | (pmail-summary-get-summary-attributes n) | ||
| 1475 | (concat (pmail-desc-get-day-number n) "-" | ||
| 1476 | (pmail-desc-get-month n)) | ||
| 1477 | (pmail-summary-get-sender n) | ||
| 1478 | (pmail-summary-get-line-count n) | ||
| 1479 | (concat str subj))))) | ||
| 1480 | |||
| 1481 | (defun pmail-summary-update (n) | ||
| 1482 | "Rewrite the summary line for message N." | ||
| 1483 | (with-current-buffer pmail-buffer | ||
| 1484 | ;; we need to do this in the pmail-buffer lest the keywords are | ||
| 1485 | ;; not recognized | ||
| 1486 | (let ((summary (pmail-summary-get-summary-line n))) | ||
| 1487 | (with-current-buffer pmail-summary-buffer | ||
| 1488 | (save-excursion | ||
| 1489 | (let ((buffer-read-only nil)) | ||
| 1490 | (pmail-summary-goto-msg n) | ||
| 1491 | ;; summary line includes newline at the end | ||
| 1492 | (delete-region (point) (1+ (line-end-position))) | ||
| 1493 | (insert summary))))))) | ||
| 1494 | |||
| 1495 | (provide 'pmailsum) | 1721 | (provide 'pmailsum) |
| 1496 | 1722 | ||
| 1497 | ;; Local Variables: | ||
| 1498 | ;; change-log-default-name: "ChangeLog.pmail" | ||
| 1499 | ;; End: | ||
| 1500 | |||
| 1501 | ;; arch-tag: 80b0a27a-a50d-4f37-9466-83d32d1e0ca8 | 1723 | ;; arch-tag: 80b0a27a-a50d-4f37-9466-83d32d1e0ca8 |
| 1502 | ;;; pmailsum.el ends here | 1724 | ;;; pmailsum.el ends here |