aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorPaul Reilly2008-10-05 14:08:21 +0000
committerPaul Reilly2008-10-05 14:08:21 +0000
commitfca0b79bef422e4f5a56081793e3c3716ce1478c (patch)
tree2d37c208a48ea7de049acd39b3bc8edcceb018a6
parenta9097c6dda772fc560a1837713efe15d8e19c9dd (diff)
downloademacs-fca0b79bef422e4f5a56081793e3c3716ce1478c.tar.gz
emacs-fca0b79bef422e4f5a56081793e3c3716ce1478c.zip
Next step in the Rmail/mbox support: getting basic summary support working.
-rw-r--r--lisp/mail/pmail.el465
-rw-r--r--lisp/mail/pmailsum.el1300
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,
82it's character representation and it's display representation.") 82it'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
945compliant.
946MSGNUM, 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
1638abstraction kind of thing to manage the code size. Return t if
1639new 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.
1991The current buffer is narrowed to the headers for some
1992message (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
2009entry should be looking at the first new message. An error will 2001entry should be looking at the first new message. An error will
2010be thrown if the new messages are not RCC2822 compliant. Lastly, 2002be thrown if the new messages are not RCC2822 compliant. Lastly,
2011unless one already exists, add an Rmail attribute header to the 2003unless one already exists, add an Rmail attribute header to the
2012new messages in the region " 2004new 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.
2485MSG, if set identifies the message number to use. The current 2478MSG, if set identifies the message number to use. The current
2486mail message will be used otherwise." 2479mail 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.
2533ATTR is a (numberic) index, an offset into the mbox attribute 2526ATTR is a (numeric) index, an offset into the mbox attribute
2534header value. STATE is one of nil, t, or a character value." 2527header 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.
2587Return 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.
2603Return the current message number if the Pmail buffer is in a
2604swapped state, i.e. it currently contains a single decoded
2605message 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.
2615If message MSGNUM is non-nil make it the current message and
2616display 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.
304If WHOLE-MESSAGE is nil only the subject header will be searched,
305otherwise the whole message will be searched for text matching
306SUBJECT. Return nil to indicate that SUBJECT is not found,
307non-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.
324SENDERS is a string of names separated by commas." 168SENDERS 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.
342The 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.
356DESCRIPTION makes part of the mode line of the summary buffer. 191DESC makes part of the mode line of the summary buffer. REDO is form ...
357For each message, FUNCTION is applied to the message number and ARGS... 192For each message, FUNC is applied to the message number and ARGS...
358and if the result is non-nil, that message is included. 193and if the result is non-nil, that message is included.
359nil for FUNCTION means all messages." 194nil 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.
228DESCRIPTION is added to the mode line.
229
230Return the summary buffer by invoking FUNCTION on each message
231passing the message number and ARGS...
232
233REDO is a form ...
234
235The current buffer must be a Pmail buffer either containing a
236collection of mbox formatted messages or displaying a single
237message."
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
299buffer, 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.
309If the message has a summary line already, it will be stored in
310the message as a header and simply returned, otherwise the
311summary line is created, saved in the message header, cached and
312returned.
313
314The 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.
334Obtain the message summary from the header if it is available
335otherwise create it and store it in the message header.
336
337The 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
357The current buffer is narrowed to the message headers for
358the 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.
376The 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.
458If non-nil, this variable is used to identify the correspondent 393If non-nil, this variable is used to identify the correspondent
459when receiving new mail. If it matches the address of the 394when receiving new mail. If it matches the address of the sender,
460sender, the recipient is taken as correspondent of a mail. It is 395the recipient is taken as correspondent of a mail.
461initialized based on your `user-login-name' and 396If nil \(default value\), your `user-login-name' and `user-mail-address'
462`user-mail-address'. 397are used to exclude yourself as correspondent.
463 398
464Usually you don't have to set this variable, except if you 399Usually you don't have to set this variable, except if you collect mails
465collect mails sent by you under different user names. Then it 400sent by you under different user names.
466should be a regexp matching your mail addresses. 401Then it should be a regexp matching your mail addresses.
467 402
468Setting this variable has an effect only before reading a mail." 403Setting 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.
478If NUMBER is positive then move forward NUMBER messages. If NUMBER is
479negative then move backwards NUMBER messages. If NUMBER is nil then
480move 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.
498With optional prefix argument NUMBER, moves forward this number of 548With optional prefix argument NUMBER, moves forward this number of non-deleted
499non-deleted messages, or backward if NUMBER is negative." 549messages, 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.
516With prefix argument N moves forward N messages with these labels." 572With 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.
527With prefix argument N moves backward N messages with these labels." 583With 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.
538With prefix argument N, do this N times. 594With prefix argument N, do this N times.
539If N is negative, go backwards." 595If 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.
547If N is negative, go forwards instead." 640If 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
670Commands 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
680The commands listed above take comma-separated lists of regular
681expressions.
682
683\\[pmail-summary-by-regexp] Filter by any header line.
684\\[pmail-summary] Restore the default summary.
685
686Commands for sorting the summary: 768Commands 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
730so that if the next motion between messages is in the same Incremental 811so that if the next motion between messages is in the same Incremental
731Search, the `unseen' attribute is restored.") 812Search, 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.
735Put the cursor on the beginning of the line containing the
736current message and highlight the buffer. Show in Pmail the
737message described by the summary line that point is on, but only
738if 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.
803If 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.
815If N is nil, use the message corresponding to point in the summary 1088If N is nil, use the message corresponding to point in the summary
816buffer and move to that message in the Pmail buffer. 1089and move to that message in the Pmail buffer.
817 1090
818If NOWARN, don't say anything if N is out of range. 1091If NOWARN, don't say anything if N is out of range.
819If SKIP-PMAIL, don't do anything to the Pmail buffer." 1092If 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."
960Position it according to WHERE which can be BEG or END" 1229Position 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.
1163Completion is performed over known labels when reading." 1462Completion 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.
1171Completion is performed over known labels when reading." 1472Completion 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;
1209prefix argument means ignore them. While composing the reply, 1512prefix argument means ignore them. While composing the reply,
1210use \\[mail-yank-original] to yank the original message into it." 1513use \\[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
1268starting with the current one. Deleted messages are skipped and don't count." 1571starting 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.
1420If 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.
1436If `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