Mercurial > emacs
changeset 98182:19ec1646fe6c
The Rmail/mbox merge has been abandoned in favor of a restart using
the current rmail.el file. A comprehensive list of changes will be
supplied when pmail.el is morphed back into rmail.el
The current status is that pmail.el supports basic Rmail navigation
(no summary support) and shows the current message in a special
buffer using buffer-swap-text. No decoding is done yet. That is the
next step.
| author | Paul Reilly <pmr@pajato.com> |
|---|---|
| date | Mon, 15 Sep 2008 20:56:53 +0000 |
| parents | a64e314c8639 |
| children | c6e248bcc708 |
| files | lisp/mail/pmail.el |
| diffstat | 1 files changed, 1866 insertions(+), 1095 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/mail/pmail.el Mon Sep 15 20:40:23 2008 +0000 +++ b/lisp/mail/pmail.el Mon Sep 15 20:56:53 2008 +0000 @@ -2,7 +2,7 @@ ;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998, ;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 -; Free Software Foundation, Inc. +;; Free Software Foundation, Inc. ;; Maintainer: FSF ;; Keywords: mail @@ -38,26 +38,72 @@ ;; variable, and a bury pmail buffer (wipe) command. ;; -(eval-when-compile - (require 'font-lock) - (require 'mailabbrev) - (require 'mule-util)) ; for detect-coding-with-priority - -(require 'pmaildesc) -(require 'pmailhdr) -(require 'pmailkwd) -(require 'mail-parse) +(require 'mail-utils) +(eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority + +(defconst pmail-attribute-header "X-BABYL-V6-ATTRIBUTES" + "The header that stores the Pmail attribute data.") + +(defconst pmail-keyword-header "X-BABYL-V6-KEYWORDS" + "The header that stores the Pmail keyword data.") + +;;; Attribute indexes + +(defconst pmail-answered-attr-index 0 + "The index for the `answered' attribute.") + +(defconst pmail-deleted-attr-index 1 + "The index for the `deleted' attribute.") + +(defconst pmail-edited-attr-index 2 + "The index for the `edited' attribute.") + +(defconst pmail-filed-attr-index 3 + "The index for the `filed' attribute.") + +(defconst pmail-resent-attr-index 4 + "The index for the `resent' attribute.") + +(defconst pmail-stored-attr-index 5 + "The index for the `stored' attribute.") + +(defconst pmail-unseen-attr-index 6 + "The index for the `unseen' attribute.") + +(defconst pmail-attr-array + '[(?A "answered") + (?D "deleted") + (?E "edited") + (?F "filed") + (?R "replied") + (?S "stored") + (?U "unseen")] + "An array that provides a mapping between an attribute index, +it's character representation and it's display representation.") + +(defconst pmail-attribute-field-name "x-babyl-v6-attributes" + "The message header field added by Rmail to maintain status.") (defvar deleted-head) (defvar font-lock-fontified) (defvar mail-abbrev-syntax-table) (defvar mail-abbrevs) (defvar messages-head) +(defvar pmail-use-spam-filter) (defvar rsf-beep) (defvar rsf-sleep-after-message) (defvar total-messages) (defvar tool-bar-map) +(defvar pmail-buffers-swapped-p nil + "A flag that is non-nil when the message view buffer and the + message collection buffer are swapped, i.e. the Pmail buffer + contains a single decoded message.") + +(defvar pmail-header-style 'normal + "The current header display style choice, one of +'normal (selected headers) or 'full (all headers).") + ; These variables now declared in paths.el. ;(defvar pmail-spool-directory "/usr/spool/mail/" ; "This is the name of the directory used by the system mailer for\n\ @@ -185,11 +231,6 @@ (defvar pmail-encoded-remote-password nil) -(defvar pmail-expunge-counter 0 - "A counter used to keep track of the number of expunged -messages with a lower message number than the current message -index.") - (defcustom pmail-preserve-inbox nil "*Non-nil means leave incoming mail in the user's inbox--don't delete it." :type 'boolean @@ -202,12 +243,8 @@ (declare-function mail-position-on-field "sendmail" (field &optional soft)) (declare-function mail-text-start "sendmail" ()) +(declare-function pmail-dont-reply-to "mail-utils" (destinations)) (declare-function pmail-update-summary "pmailsum" (&rest ignore)) -(declare-function unrmail "unrmail" (file to-file)) -(declare-function rmail-dont-reply-to "mail-utils" (destinations)) -(declare-function pmail-summary-goto-msg "pmailsum" (&optional n nowarn skip-pmail)) -(declare-function pmail-summary-pmail-update "pmailsum" ()) -(declare-function pmail-summary-update "pmailsum" (n)) (defun pmail-probe (prog) "Determine what flavor of movemail PROG is. @@ -311,7 +348,7 @@ "\\|^importance:\\|^envelope-to:\\|^delivery-date\\|^openpgp:" "\\|^mbox-line:\\|^cancel-lock:\\|^DomainKey-Signature:" "\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:" - "\\|^x-.*:\\|^domainkey-signature:\\|^original-recipient:\\|^from ") + "\\|^x-.*:") "*Regexp to match header fields that Pmail should normally hide. \(See also `pmail-nonignored-headers', which overrides this regexp.) This variable is used for reformatting the message header, @@ -355,8 +392,7 @@ ;;;###autoload (defcustom pmail-highlighted-headers "^From:\\|^Subject:" "\ *Regexp to match Header fields that Pmail should normally highlight. -A value of nil means don't highlight. -See also `pmail-highlight-face'." +A value of nil means don't highlight." :type 'regexp :group 'pmail-headers) @@ -373,14 +409,6 @@ :version "23.1") ;;;###autoload -(defcustom pmail-highlight-face 'pmail-highlight "\ -*Face used by Pmail for highlighting sender and subject. -See `pmail-font-lock-keywords'." - :type '(choice (const :tag "Default" nil) - face) - :group 'pmail-headers) - -;;;###autoload (defcustom pmail-delete-after-output nil "\ *Non-nil means automatically delete a message that is copied to a file." :type 'boolean @@ -403,22 +431,6 @@ :group 'pmail-files) ;;;###autoload -(defcustom pmail-inbox-alist nil - "*Alist of mail files and backup directory names. -Each element has the form (MAIL-FILE INBOX ...). When running -pmail on MAIL-FILE, mails in all the INBOX files listed will be -moved to the MAIL-FILE. Be sure to fully qualify your MAIL-FILE. - -Example setting if procmail delivers all your spam to -~/Mail/SPAM.in and you read it from the file ~/Mail/SPAM: - -\(setq pmail-inbox-alist '((\"~/Mail/SPAM\" \"~/Mail/SPAM.in\")))" - :type '(alist :key-type file :value-type (repeat file)) - :group 'pmail-retrieve - :group 'pmail-files - :version "22.1") - -;;;###autoload (defcustom pmail-mail-new-frame nil "*Non-nil means Pmail makes a new frame for composing outgoing mail. This is handy if you want to preserve the window configuration of @@ -493,9 +505,8 @@ (FOLDERNAME FIELD REGEXP [ FIELD REGEXP ] ... ) -Where FOLDERNAME is the name of a BABYL Version 6 (also known as mbox -or Unix inbox format) folder to put the message. If any of the field -regexp's are nil, then it is ignored. +Where FOLDERNAME is the name of a BABYL format folder to put the +message. If any of the field regexp's are nil, then it is ignored. If FOLDERNAME is \"/dev/null\", it is deleted. If FOLDERNAME is nil then it is deleted, and skipped. @@ -549,6 +560,18 @@ (defvar pmail-total-messages nil) (put 'pmail-total-messages 'permanent-local t) +(defvar pmail-message-vector nil) +(put 'pmail-message-vector 'permanent-local t) + +(defvar pmail-deleted-vector nil) +(put 'pmail-deleted-vector 'permanent-local t) + +(defvar pmail-msgref-vector nil + "In an Pmail buffer, a vector whose Nth element is a list (N). +When expunging renumbers messages, these lists are modified +by substituting the new message number into the existing list.") +(put 'pmail-msgref-vector 'permanent-local t) + (defvar pmail-overlay-list nil) (put 'pmail-overlay-list 'permanent-local t) @@ -556,6 +579,8 @@ (defvar pmail-summary-buffer nil) (put 'pmail-summary-buffer 'permanent-local t) +(defvar pmail-summary-vector nil) +(put 'pmail-summary-vector 'permanent-local t) (defvar pmail-view-buffer nil "Buffer which holds PMAIL message for MIME displaying.") @@ -577,12 +602,10 @@ "*Default file name for \\[pmail-output]." :type 'file :group 'pmail-files) - (defcustom pmail-default-pmail-file "~/XMAIL" "*Default file name for \\[pmail-output-to-pmail-file]." :type 'file :group 'pmail-files) - (defcustom pmail-default-body-file "~/mailout" "*Default file name for \\[pmail-output-body-to-file]." :type 'file @@ -683,8 +706,9 @@ ;;; Regexp matching the delimiter of messages in UNIX mail format -;;; (UNIX From lines), with an initial ^. Used in pmail-decode-from-line, -;;; which knows the exact ordering of the \\(...\\) subexpressions. +;;; (UNIX From lines), minus the initial ^. Note that if you change +;;; this expression, you must change the code in pmail-nuke-pinhead-header +;;; that knows the exact ordering of the \\( \\) subexpressions. (defvar pmail-unix-mail-delimiter (let ((time-zone-regexp (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?" @@ -692,7 +716,7 @@ "\\|" "\\) *"))) (concat - "^From " + "From " ;; Many things can happen to an RFC 822 mailbox before it is put into ;; a `From' line. The leading phrase can be stripped, e.g. @@ -743,18 +767,13 @@ (let* ((cite-chars "[>|}]") (cite-prefix "a-z") (cite-suffix (concat cite-prefix "0-9_.@-`'\""))) - (list '("^\\(Sender\\|Resent-From\\):" - . font-lock-function-name-face) - '("^Reply-To:.*$" . font-lock-function-name-face) - '("^\\(From:\\)\\(.*\\(\n[ \t]+.*\\)*\\)" - (1 font-lock-function-name-face) - (2 pmail-highlight-face)) - '("^\\(Subject:\\)\\(.*\\(\n[ \t]+.*\\)*\\)" - (1 font-lock-comment-face) - (2 pmail-highlight-face)) - '("^X-Spam-Status:" . font-lock-keyword-face) + (list '("^\\(From\\|Sender\\|Resent-From\\):" + . 'pmail-header-name) + '("^Reply-To:.*$" . 'pmail-header-name) + '("^Subject:" . 'pmail-header-name) + '("^X-Spam-Status:" . 'pmail-header-name) '("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):" - . font-lock-keyword-face) + . 'pmail-header-name) ;; Use MATCH-ANCHORED to effectively anchor the regexp left side. `(,cite-chars (,(concat "\\=[ \t]*" @@ -798,11 +817,6 @@ (defvar pmail-enable-multibyte nil) -;; XXX rmail-spam-filter hasn't been tested at all with the mbox -;; branch. --enberg -(defvar pmail-use-spam-filter nil - "*Non-nil to activate the rmail spam filter with pmail. -WARNING - this has not been tested at all with pmail.") (defun pmail-require-mime-maybe () "Require `pmail-mime-feature' if that is non-nil. @@ -822,6 +836,7 @@ pmail-mime-feature)) (setq pmail-enable-mime nil))))) + ;;;###autoload (defun pmail (&optional file-name-arg) "Read and edit incoming mail. @@ -849,239 +864,339 @@ (if existed (with-current-buffer existed enable-multibyte-characters) (default-value 'enable-multibyte-characters))) + ;; Since the file may contain messages of different encodings + ;; at the tail (non-BYBYL part), we can't decode them at once + ;; on reading. So, at first, we read the file without text + ;; code conversion, then decode the messages one by one by + ;; pmail-decode-babyl-format or + ;; pmail-convert-to-babyl-format. + (coding-system-for-read (and pmail-enable-multibyte 'raw-text)) run-mail-hook msg-shown) - (when (and existed (eq major-mode 'pmail-edit-mode)) - (error "Exit Pmail Edit mode before getting new mail")) + ;; Like find-file, but in the case where a buffer existed + ;; and the file was reverted, recompute the message-data. + ;; We used to bind enable-local-variables to nil here, + ;; but that should not be needed now that pmail-mode + ;; sets it locally to nil. + ;; (Binding a variable locally with let is not safe if it has + ;; buffer-local bindings.) (if (and existed (not (verify-visited-file-modtime existed))) (progn (find-file file-name) (when (and (verify-visited-file-modtime existed) (eq major-mode 'pmail-mode)) - (setq major-mode 'fundamental-mode))) - (switch-to-buffer - (let ((enable-local-variables nil)) - (find-file-noselect file-name))) - ;; As we have read a file as raw-text, the buffer is set to - ;; unibyte. We must make it multibyte if necessary. - (when (and pmail-enable-multibyte - (not enable-multibyte-characters)) - (set-buffer-multibyte t))) - ;; Make sure we're in pmail-mode, even if the buffer did exist and - ;; the file was not changed. - (unless (eq major-mode 'pmail-mode) - ;; If file looks like a Babyl file, save it to a temp file, - ;; convert it, and replace the current content with the - ;; converted content. Don't save -- let the user do it. - (goto-char (point-min)) - (when (looking-at "BABYL OPTIONS:") - (let ((old-file (make-temp-file "pmail")) - (new-file (make-temp-file "pmail"))) - (unwind-protect - (progn - (write-region (point-min) (point-max) old-file) - (unrmail old-file new-file) - (message "Replacing BABYL format with mbox format...") - (let ((inhibit-read-only t)) - (erase-buffer) - (insert-file-contents-literally new-file)) - (message "Replacing BABYL format with mbox format...done")) - (delete-file old-file) - (delete-file new-file)))) - (goto-char (point-max)) + (pmail-forget-messages) + (pmail-set-message-counters))) + (switch-to-buffer + (let ((enable-local-variables nil)) + (find-file-noselect file-name)))) + (setq pmail-buffers-swapped-p nil) + (if (eq major-mode 'pmail-edit-mode) + (error "Exit Pmail Edit mode before getting new mail")) + (if (and existed (> (buffer-size) 0)) + ;; Buffer not new and not empty; ensure in proper mode, but that's all. + (or (eq major-mode 'pmail-mode) + (progn (pmail-mode-2) + (setq run-mail-hook t))) + (setq run-mail-hook t) (pmail-mode-2) - ;; Convert all or parts of file to a format Pmail understands - (pmail-convert-file) - ;; We use `run-mail-hook' to remember whether we should run - ;; `pmail-mode-hook' at the end. - (setq run-mail-hook t) - ;; Initialize the Pmail state. - (pmail-initialize-messages)) - ;; Now we're back in business. The happens even if we had a - ;; perfectly fine file. + (pmail-convert-file-maybe) + (goto-char (point-max))) + ;; As we have read a file by raw-text, the buffer is set to + ;; unibyte. We must make it multibyte if necessary. + (if (and pmail-enable-multibyte + (not enable-multibyte-characters)) + (set-buffer-multibyte t)) + ;; If necessary, scan to find all the messages. + (pmail-maybe-set-message-counters) (unwind-protect (unless (and (not file-name-arg) (pmail-get-new-mail)) (pmail-show-message (pmail-first-unseen-message))) - (when pmail-display-summary - (pmail-summary)) - (pmail-construct-io-menu) - ;; Run any callbacks if the buffer was not in pmail-mode - (when run-mail-hook - (run-hooks 'pmail-mode-hook))))) - -(defun pmail-convert-file () - "Convert unconverted messages. -A message is unconverted if it doesn't have the BABYL header -specified in `pmail-header-attribute-header'; it is converted -using `pmail-convert-mbox-format'." - (let ((convert - (save-restriction - (widen) - (let ((case-fold-search nil) - (start (point-max)) - end) - (catch 'convert - (goto-char start) - (while (re-search-backward - pmail-unix-mail-delimiter nil t) - (setq end start) - (setq start (point)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - (let ((attribute (pmail-header-get-header - pmail-header-attribute-header))) - (unless attribute - (throw 'convert t))))))))))) - (if convert - (let ((inhibit-read-only t)) - (pmail-convert-mbox-format))))) - -(defun pmail-initialize-messages () - "Initialize message state based on messages in the buffer." - (setq pmail-total-messages 0 - pmail-current-message 1) - (pmail-desc-clear-descriptors) + (progn + (if pmail-display-summary (pmail-summary)) + (pmail-construct-io-menu) + (if run-mail-hook + (run-hooks 'pmail-mode-hook)))))) + +;; Given the value of MAILPATH, return a list of inbox file names. +;; This is turned off because it is not clear that the user wants +;; all these inboxes to feed into the primary pmail file. +; (defun pmail-convert-mailpath (string) +; (let (idx list) +; (while (setq idx (string-match "[%:]" string)) +; (let ((this (substring string 0 idx))) +; (setq string (substring string (1+ idx))) +; (setq list (cons (if (string-match "%" this) +; (substring this 0 (string-match "%" this)) +; this) +; list)))) +; list)) + +; I have checked that adding "-*- pmail -*-" to the BABYL OPTIONS line +; will not cause emacs 18.55 problems. + +;; This calls pmail-decode-babyl-format if the file is already Babyl. + +(defun pmail-convert-file-maybe () + "Determine if the file needs to be converted to mbox format." (widen) - (pmail-header-show-headers) - (setq pmail-total-messages (pmail-process-new-messages))) - -(defvar pmail-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (define-key map "a" 'pmail-add-label) - (define-key map "b" 'pmail-bury) - (define-key map "c" 'pmail-continue) - (define-key map "d" 'pmail-delete-forward) - (define-key map "\C-d" 'pmail-delete-backward) - (define-key map "e" 'pmail-edit-current-message) - (define-key map "f" 'pmail-forward) - (define-key map "g" 'pmail-get-new-mail) - (define-key map "h" 'pmail-summary) - (define-key map "i" 'pmail-input) - (define-key map "j" 'pmail-show-message) - (define-key map "k" 'pmail-kill-label) - (define-key map "l" 'pmail-summary-by-labels) - (define-key map "\e\C-h" 'pmail-summary) - (define-key map "\e\C-l" 'pmail-summary-by-labels) - (define-key map "\e\C-r" 'pmail-summary-by-recipients) - (define-key map "\e\C-s" 'pmail-summary-by-regexp) - (define-key map "\e\C-t" 'pmail-summary-by-topic) - (define-key map "m" 'pmail-mail) - (define-key map "\em" 'pmail-retry-failure) - (define-key map "n" 'pmail-next-undeleted-message) - (define-key map "\en" 'pmail-next-message) - (define-key map "\e\C-n" 'pmail-next-labeled-message) - (define-key map "o" 'pmail-output) - (define-key map "\C-o" 'pmail-output) - (define-key map "p" 'pmail-previous-undeleted-message) - (define-key map "\ep" 'pmail-previous-message) - (define-key map "\e\C-p" 'pmail-previous-labeled-message) - (define-key map "q" 'pmail-quit) - (define-key map "r" 'pmail-reply) - ;; I find I can't live without the default M-r command -- rms. - ;; (define-key map "\er" 'pmail-search-backwards) - (define-key map "s" 'pmail-expunge-and-save) - (define-key map "\es" 'pmail-search) - (define-key map "t" 'pmail-toggle-header) - (define-key map "u" 'pmail-undelete-previous-message) - (define-key map "w" 'pmail-output-body-to-file) - (define-key map "x" 'pmail-expunge) - (define-key map "." 'pmail-beginning-of-message) - (define-key map "/" 'pmail-end-of-message) - (define-key map "<" 'pmail-first-message) - (define-key map ">" 'pmail-last-message) - (define-key map " " 'scroll-up) - (define-key map "\177" 'scroll-down) - (define-key map "?" 'describe-mode) - (define-key map "\C-c\C-s\C-d" 'pmail-sort-by-date) - (define-key map "\C-c\C-s\C-s" 'pmail-sort-by-subject) - (define-key map "\C-c\C-s\C-a" 'pmail-sort-by-author) - (define-key map "\C-c\C-s\C-r" 'pmail-sort-by-recipient) - (define-key map "\C-c\C-s\C-c" 'pmail-sort-by-correspondent) - (define-key map "\C-c\C-s\C-l" 'pmail-sort-by-lines) - (define-key map "\C-c\C-s\C-k" 'pmail-sort-by-labels) - (define-key map "\C-c\C-n" 'pmail-next-same-subject) - (define-key map "\C-c\C-p" 'pmail-previous-same-subject) - (define-key map [menu-bar] (make-sparse-keymap)) - (define-key map [menu-bar classify] - (cons "Classify" (make-sparse-keymap "Classify"))) - (define-key map [menu-bar classify input-menu] - nil) - (define-key map [menu-bar classify output-menu] - nil) - (define-key map [menu-bar classify output-body] - '("Output body to file..." . pmail-output-body-to-file)) - (define-key map [menu-bar classify output-inbox] - '("Output (inbox)..." . pmail-output)) - (define-key map [menu-bar classify output] - '("Output (Pmail)..." . pmail-output)) - (define-key map [menu-bar classify kill-label] - '("Kill Label..." . pmail-kill-label)) - (define-key map [menu-bar classify add-label] - '("Add Label..." . pmail-add-label)) - (define-key map [menu-bar summary] - (cons "Summary" (make-sparse-keymap "Summary"))) - (define-key map [menu-bar summary senders] - '("By Senders..." . pmail-summary-by-senders)) - (define-key map [menu-bar summary labels] - '("By Labels..." . pmail-summary-by-labels)) - (define-key map [menu-bar summary recipients] - '("By Recipients..." . pmail-summary-by-recipients)) - (define-key map [menu-bar summary topic] - '("By Topic..." . pmail-summary-by-topic)) - (define-key map [menu-bar summary regexp] - '("By Regexp..." . pmail-summary-by-regexp)) - (define-key map [menu-bar summary all] - '("All" . pmail-summary)) - (define-key map [menu-bar mail] - (cons "Mail" (make-sparse-keymap "Mail"))) - (define-key map [menu-bar mail pmail-get-new-mail] - '("Get New Mail" . pmail-get-new-mail)) - (define-key map [menu-bar mail lambda] - '("----")) - (define-key map [menu-bar mail continue] - '("Continue" . pmail-continue)) - (define-key map [menu-bar mail resend] - '("Re-send..." . pmail-resend)) - (define-key map [menu-bar mail forward] - '("Forward" . pmail-forward)) - (define-key map [menu-bar mail retry] - '("Retry" . pmail-retry-failure)) - (define-key map [menu-bar mail reply] - '("Reply" . pmail-reply)) - (define-key map [menu-bar mail mail] - '("Mail" . pmail-mail)) - (define-key map [menu-bar delete] - (cons "Delete" (make-sparse-keymap "Delete"))) - (define-key map [menu-bar delete expunge/save] - '("Expunge/Save" . pmail-expunge-and-save)) - (define-key map [menu-bar delete expunge] - '("Expunge" . pmail-expunge)) - (define-key map [menu-bar delete undelete] - '("Undelete" . pmail-undelete-previous-message)) - (define-key map [menu-bar delete delete] - '("Delete" . pmail-delete-forward)) - (define-key map [menu-bar move] - (cons "Move" (make-sparse-keymap "Move"))) - (define-key map [menu-bar move search-back] - '("Search Back..." . pmail-search-backwards)) - (define-key map [menu-bar move search] - '("Search..." . pmail-search)) - (define-key map [menu-bar move previous] - '("Previous Nondeleted" . pmail-previous-undeleted-message)) - (define-key map [menu-bar move next] - '("Next Nondeleted" . pmail-next-undeleted-message)) - (define-key map [menu-bar move last] - '("Last" . pmail-last-message)) - (define-key map [menu-bar move first] - '("First" . pmail-first-message)) - (define-key map [menu-bar move previous] - '("Previous" . pmail-previous-message)) - (define-key map [menu-bar move next] - '("Next" . pmail-next-message)) - map) - "Keymap for `pmail-mode'.") + (goto-char (point-min)) + ;; Detect previous Babyl format files. + (cond ((looking-at "BABYL OPTIONS:") + ;; The file is Babyl version 5. Use unrmail to convert + ;; it. + (pmail-convert-babyl-to-mbox)) + ((looking-at "Version: 5\n") + ;; Losing babyl file made by old version of Pmail. Fix the + ;; babyl file header and use unrmail to convert to mbox + ;; format. + (let ((buffer-read-only nil)) + (insert "BABYL OPTIONS: -*- pmail -*-\n") + (pmail-convert-babyl-to-mbox))) + ((equal (point-min) (point-max)) + (message "Empty Pmail file.")) + ((looking-at "From ")) + (t (error "Invalid mbox format mail file.")))) + +(defun pmail-convert-babyl-to-mbox () + "Convert the mail file from Babyl version 5 to mbox." + (let ((old-file (make-temp-file "pmail")) + (new-file (make-temp-file "pmail"))) + (unwind-protect + (progn + (write-region (point-min) (point-max) old-file) + (unrmail old-file new-file) + (message "Replacing BABYL format with mbox format...") + (let ((inhibit-read-only t)) + (erase-buffer) + (insert-file-contents-literally new-file)) + (message "Replacing BABYL format with mbox format...done")) + (delete-file old-file) + (delete-file new-file)))) + +(defun pmail-insert-pmail-file-header () + (let ((buffer-read-only nil)) + ;; -*-pmail-*- is here so that visiting the file normally + ;; recognizes it as an Pmail file. + (insert "BABYL OPTIONS: -*- pmail -*- +Version: 5 +Labels: +Note: This is the header of an pmail file. +Note: If you are seeing it in pmail, +Note: it means the file has no messages in it.\n\^_"))) + +;; Decode Babyl formatted part at the head of current buffer by +;; pmail-file-coding-system, or if it is nil, do auto conversion. + +(defun pmail-decode-babyl-format () + (let ((modifiedp (buffer-modified-p)) + (buffer-read-only nil) + (coding-system pmail-file-coding-system) + from to) + (goto-char (point-min)) + (search-forward "\n\^_" nil t) ; Skip BABYL header. + (setq from (point)) + (goto-char (point-max)) + (search-backward "\n\^_" from 'mv) + (setq to (point)) + (unless (and coding-system + (coding-system-p coding-system)) + (setq coding-system + ;; If pmail-file-coding-system is nil, Emacs 21 writes + ;; PMAIL files in emacs-mule, Emacs 22 in utf-8, but + ;; earlier versions did that with the current buffer's + ;; encoding. So we want to favor detection of emacs-mule + ;; (whose normal priority is quite low) and utf-8, but + ;; still allow detection of other encodings if they won't + ;; fit. The call to with-coding-priority below achieves + ;; that. + (with-coding-priority '(emacs-mule utf-8) + (detect-coding-region from to 'highest)))) + (unless (eq (coding-system-type coding-system) 'undecided) + (set-buffer-modified-p t) ; avoid locking when decoding + (let ((buffer-undo-list t)) + (decode-coding-region from to coding-system)) + (setq coding-system last-coding-system-used)) + (set-buffer-modified-p modifiedp) + (setq buffer-file-coding-system nil) + (setq save-buffer-coding-system + (or coding-system 'undecided)))) + +(defvar pmail-mode-map nil) +(if pmail-mode-map + nil + (setq pmail-mode-map (make-keymap)) + (suppress-keymap pmail-mode-map) + (define-key pmail-mode-map "a" 'pmail-add-label) + (define-key pmail-mode-map "b" 'pmail-bury) + (define-key pmail-mode-map "c" 'pmail-continue) + (define-key pmail-mode-map "d" 'pmail-delete-forward) + (define-key pmail-mode-map "\C-d" 'pmail-delete-backward) + (define-key pmail-mode-map "e" 'pmail-edit-current-message) + (define-key pmail-mode-map "f" 'pmail-forward) + (define-key pmail-mode-map "g" 'pmail-get-new-mail) + (define-key pmail-mode-map "h" 'pmail-summary) + (define-key pmail-mode-map "i" 'pmail-input) + (define-key pmail-mode-map "j" 'pmail-show-message) + (define-key pmail-mode-map "k" 'pmail-kill-label) + (define-key pmail-mode-map "l" 'pmail-summary-by-labels) + (define-key pmail-mode-map "\e\C-h" 'pmail-summary) + (define-key pmail-mode-map "\e\C-l" 'pmail-summary-by-labels) + (define-key pmail-mode-map "\e\C-r" 'pmail-summary-by-recipients) + (define-key pmail-mode-map "\e\C-s" 'pmail-summary-by-regexp) + (define-key pmail-mode-map "\e\C-t" 'pmail-summary-by-topic) + (define-key pmail-mode-map "m" 'pmail-mail) + (define-key pmail-mode-map "\em" 'pmail-retry-failure) + (define-key pmail-mode-map "n" 'pmail-next-undeleted-message) + (define-key pmail-mode-map "\en" 'pmail-next-message) + (define-key pmail-mode-map "\e\C-n" 'pmail-next-labeled-message) + (define-key pmail-mode-map "o" 'pmail-output-to-pmail-file) + (define-key pmail-mode-map "\C-o" 'pmail-output) + (define-key pmail-mode-map "p" 'pmail-previous-undeleted-message) + (define-key pmail-mode-map "\ep" 'pmail-previous-message) + (define-key pmail-mode-map "\e\C-p" 'pmail-previous-labeled-message) + (define-key pmail-mode-map "q" 'pmail-quit) + (define-key pmail-mode-map "r" 'pmail-reply) +;; I find I can't live without the default M-r command -- rms. +;; (define-key pmail-mode-map "\er" 'pmail-search-backwards) + (define-key pmail-mode-map "s" 'pmail-expunge-and-save) + (define-key pmail-mode-map "\es" 'pmail-search) + (define-key pmail-mode-map "t" 'pmail-toggle-header) + (define-key pmail-mode-map "u" 'pmail-undelete-previous-message) + (define-key pmail-mode-map "w" 'pmail-output-body-to-file) + (define-key pmail-mode-map "x" 'pmail-expunge) + (define-key pmail-mode-map "." 'pmail-beginning-of-message) + (define-key pmail-mode-map "/" 'pmail-end-of-message) + (define-key pmail-mode-map "<" 'pmail-first-message) + (define-key pmail-mode-map ">" 'pmail-last-message) + (define-key pmail-mode-map " " 'scroll-up) + (define-key pmail-mode-map "\177" 'scroll-down) + (define-key pmail-mode-map "?" 'describe-mode) + (define-key pmail-mode-map "\C-c\C-s\C-d" 'pmail-sort-by-date) + (define-key pmail-mode-map "\C-c\C-s\C-s" 'pmail-sort-by-subject) + (define-key pmail-mode-map "\C-c\C-s\C-a" 'pmail-sort-by-author) + (define-key pmail-mode-map "\C-c\C-s\C-r" 'pmail-sort-by-recipient) + (define-key pmail-mode-map "\C-c\C-s\C-c" 'pmail-sort-by-correspondent) + (define-key pmail-mode-map "\C-c\C-s\C-l" 'pmail-sort-by-lines) + (define-key pmail-mode-map "\C-c\C-s\C-k" 'pmail-sort-by-labels) + (define-key pmail-mode-map "\C-c\C-n" 'pmail-next-same-subject) + (define-key pmail-mode-map "\C-c\C-p" 'pmail-previous-same-subject) + ) + +(define-key pmail-mode-map [menu-bar] (make-sparse-keymap)) + +(define-key pmail-mode-map [menu-bar classify] + (cons "Classify" (make-sparse-keymap "Classify"))) + +(define-key pmail-mode-map [menu-bar classify input-menu] + nil) + +(define-key pmail-mode-map [menu-bar classify output-menu] + nil) + +(define-key pmail-mode-map [menu-bar classify output-body] + '("Output body to file..." . pmail-output-body-to-file)) + +(define-key pmail-mode-map [menu-bar classify output-inbox] + '("Output (inbox)..." . pmail-output)) + +(define-key pmail-mode-map [menu-bar classify output] + '("Output (Pmail)..." . pmail-output-to-pmail-file)) + +(define-key pmail-mode-map [menu-bar classify kill-label] + '("Kill Label..." . pmail-kill-label)) + +(define-key pmail-mode-map [menu-bar classify add-label] + '("Add Label..." . pmail-add-label)) + +(define-key pmail-mode-map [menu-bar summary] + (cons "Summary" (make-sparse-keymap "Summary"))) + +(define-key pmail-mode-map [menu-bar summary senders] + '("By Senders..." . pmail-summary-by-senders)) + +(define-key pmail-mode-map [menu-bar summary labels] + '("By Labels..." . pmail-summary-by-labels)) + +(define-key pmail-mode-map [menu-bar summary recipients] + '("By Recipients..." . pmail-summary-by-recipients)) + +(define-key pmail-mode-map [menu-bar summary topic] + '("By Topic..." . pmail-summary-by-topic)) + +(define-key pmail-mode-map [menu-bar summary regexp] + '("By Regexp..." . pmail-summary-by-regexp)) + +(define-key pmail-mode-map [menu-bar summary all] + '("All" . pmail-summary)) + +(define-key pmail-mode-map [menu-bar mail] + (cons "Mail" (make-sparse-keymap "Mail"))) + +(define-key pmail-mode-map [menu-bar mail pmail-get-new-mail] + '("Get New Mail" . pmail-get-new-mail)) + +(define-key pmail-mode-map [menu-bar mail lambda] + '("----")) + +(define-key pmail-mode-map [menu-bar mail continue] + '("Continue" . pmail-continue)) + +(define-key pmail-mode-map [menu-bar mail resend] + '("Re-send..." . pmail-resend)) + +(define-key pmail-mode-map [menu-bar mail forward] + '("Forward" . pmail-forward)) + +(define-key pmail-mode-map [menu-bar mail retry] + '("Retry" . pmail-retry-failure)) + +(define-key pmail-mode-map [menu-bar mail reply] + '("Reply" . pmail-reply)) + +(define-key pmail-mode-map [menu-bar mail mail] + '("Mail" . pmail-mail)) + +(define-key pmail-mode-map [menu-bar delete] + (cons "Delete" (make-sparse-keymap "Delete"))) + +(define-key pmail-mode-map [menu-bar delete expunge/save] + '("Expunge/Save" . pmail-expunge-and-save)) + +(define-key pmail-mode-map [menu-bar delete expunge] + '("Expunge" . pmail-expunge)) + +(define-key pmail-mode-map [menu-bar delete undelete] + '("Undelete" . pmail-undelete-previous-message)) + +(define-key pmail-mode-map [menu-bar delete delete] + '("Delete" . pmail-delete-forward)) + +(define-key pmail-mode-map [menu-bar move] + (cons "Move" (make-sparse-keymap "Move"))) + +(define-key pmail-mode-map [menu-bar move search-back] + '("Search Back..." . pmail-search-backwards)) + +(define-key pmail-mode-map [menu-bar move search] + '("Search..." . pmail-search)) + +(define-key pmail-mode-map [menu-bar move previous] + '("Previous Nondeleted" . pmail-previous-undeleted-message)) + +(define-key pmail-mode-map [menu-bar move next] + '("Next Nondeleted" . pmail-next-undeleted-message)) + +(define-key pmail-mode-map [menu-bar move last] + '("Last" . pmail-last-message)) + +(define-key pmail-mode-map [menu-bar move first] + '("First" . pmail-first-message)) + +(define-key pmail-mode-map [menu-bar move previous] + '("Previous" . pmail-previous-message)) + +(define-key pmail-mode-map [menu-bar move next] + '("Next" . pmail-next-message)) ;; Pmail toolbar (defvar pmail-tool-bar-map @@ -1175,12 +1290,14 @@ (let ((finding-pmail-file (not (eq major-mode 'pmail-mode)))) (pmail-mode-2) (when (and finding-pmail-file - (null coding-system-for-read) - default-enable-multibyte-characters) + (null coding-system-for-read) + default-enable-multibyte-characters) (let ((pmail-enable-multibyte t)) - (pmail-require-mime-maybe) - (goto-char (point-max)) - (set-buffer-multibyte t))) + (pmail-require-mime-maybe) + (pmail-convert-file-maybe) + (goto-char (point-max)) + (set-buffer-multibyte t))) + (pmail-set-message-counters) (pmail-show-message pmail-total-messages) (when finding-pmail-file (when pmail-display-summary @@ -1209,22 +1326,30 @@ (set-syntax-table text-mode-syntax-table) (setq local-abbrev-table text-mode-abbrev-table)) +(defun pmail-generate-viewer-buffer () + "Return a newly created buffer suitable for viewing messages." + (let ((suffix (file-name-nondirectory (or buffer-file-name (buffer-name))))) + (generate-new-buffer (format " *message-viewer %s*" suffix)))) + ;; Set up the permanent locals associated with an Pmail file. (defun pmail-perm-variables () (make-local-variable 'pmail-last-label) (make-local-variable 'pmail-last-regexp) + (make-local-variable 'pmail-deleted-vector) (make-local-variable 'pmail-buffer) (setq pmail-buffer (current-buffer)) (make-local-variable 'pmail-view-buffer) - (setq pmail-view-buffer pmail-buffer) + (setq pmail-view-buffer (pmail-generate-viewer-buffer)) (make-local-variable 'pmail-summary-buffer) + (make-local-variable 'pmail-summary-vector) (make-local-variable 'pmail-current-message) (make-local-variable 'pmail-total-messages) (make-local-variable 'pmail-overlay-list) (setq pmail-overlay-list nil) - (make-local-variable 'pmail-desc-vector) + (make-local-variable 'pmail-message-vector) + (make-local-variable 'pmail-msgref-vector) (make-local-variable 'pmail-inbox-list) - (setq pmail-inbox-list (pmail-get-file-inbox-list)) + (setq pmail-inbox-list (pmail-parse-file-inboxes)) ;; Provide default set of inboxes for primary mail file ~/PMAIL. (and (null pmail-inbox-list) (or (equal buffer-file-name (expand-file-name pmail-file-name)) @@ -1237,11 +1362,19 @@ (user-login-name))))))) (make-local-variable 'pmail-keywords) (set (make-local-variable 'tool-bar-map) pmail-tool-bar-map) + (make-local-variable 'pmail-buffers-swapped-p) ;; this gets generated as needed (setq pmail-keywords nil)) ;; Set up the non-permanent locals associated with Pmail mode. (defun pmail-variables () + (make-local-variable 'save-buffer-coding-system) + ;; If we don't already have a value for save-buffer-coding-system, + ;; get it from buffer-file-coding-system, and clear that + ;; because it should be determined in pmail-show-message. + (unless save-buffer-coding-system + (setq save-buffer-coding-system (or buffer-file-coding-system 'undecided)) + (setq buffer-file-coding-system nil)) ;; Don't let a local variables list in a message cause confusion. (make-local-variable 'local-enable-local-variables) (setq local-enable-local-variables nil) @@ -1268,60 +1401,61 @@ ;; Handle M-x revert-buffer done in an pmail-mode buffer. (defun pmail-revert (arg noconfirm) - (with-current-buffer pmail-buffer - (let* ((revert-buffer-function (default-value 'revert-buffer-function)) - (pmail-enable-multibyte enable-multibyte-characters)) - ;; Call our caller again, but this time it does the default thing. - (when (revert-buffer arg noconfirm) - ;; If the user said "yes", and we changed something, reparse the - ;; messages. - (with-current-buffer pmail-buffer - (pmail-mode-2) - (pmail-convert-file) - ;; We have read the file as raw-text, so the buffer is set to - ;; unibyte. Make it multibyte if necessary. - (when (and pmail-enable-multibyte - (not enable-multibyte-characters)) - (set-buffer-multibyte t)) - (pmail-initialize-messages) - (pmail-show-message pmail-total-messages) - (run-hooks 'pmail-mode-hook)))))) - -(defun pmail-get-file-inbox-list () - "Return a list of inbox files for this buffer." - (let* ((filename (expand-file-name (buffer-file-name))) - (inboxes (cdr (or (assoc filename pmail-inbox-alist) - (assoc (abbreviate-file-name filename) - pmail-inbox-alist)))) - (list nil)) - (dolist (i inboxes) - (when (file-name-absolute-p i) - (push (expand-file-name i) list))) - (nreverse list))) - -;;; mbox: ready + (set-buffer pmail-buffer) + (let* ((revert-buffer-function (default-value 'revert-buffer-function)) + (pmail-enable-multibyte enable-multibyte-characters) + ;; See similar code in `pmail'. + (coding-system-for-read (and pmail-enable-multibyte 'raw-text))) + ;; Call our caller again, but this time it does the default thing. + (when (revert-buffer arg noconfirm) + ;; If the user said "yes", and we changed something, + ;; reparse the messages. + (set-buffer pmail-buffer) + (pmail-mode-2) + ;; Convert all or part to Babyl file if possible. + (pmail-convert-file-maybe) + ;; We have read the file as raw-text, so the buffer is set to + ;; unibyte. Make it multibyte if necessary. + (if (and pmail-enable-multibyte + (not enable-multibyte-characters)) + (set-buffer-multibyte t)) + (goto-char (point-max)) + (pmail-set-message-counters) + (pmail-show-message pmail-total-messages) + (run-hooks 'pmail-mode-hook)))) + +;; Return a list of files from this buffer's Mail: option. +;; Does not assume that messages have been parsed. +;; Just returns nil if buffer does not look like Babyl format. +(defun pmail-parse-file-inboxes () + (save-excursion + (save-restriction + (widen) + (goto-char 1) + (cond ((looking-at "BABYL OPTIONS:") + (search-forward "\n\^_" nil 'move) + (narrow-to-region 1 (point)) + (goto-char 1) + (when (search-forward "\nMail:" nil t) + (narrow-to-region (point) (progn (end-of-line) (point))) + (goto-char (point-min)) + (mail-parse-comma-list))))))) + (defun pmail-expunge-and-save () "Expunge and save PMAIL file." (interactive) (pmail-expunge) + (set-buffer pmail-buffer) (save-buffer) - (pmail-display-summary-maybe)) - -;;; mbox: ready -(defun pmail-display-summary-maybe () - "If a summary buffer exists then make sure it is updated and displayed." (if (pmail-summary-exists) - (let ((current-message pmail-current-message)) - (pmail-select-summary - (pmail-summary-goto-msg current-message) - (pmail-summary-pmail-update) - (set-buffer-modified-p nil))))) - -;;; mbox: ready + (pmail-select-summary (set-buffer-modified-p nil)))) + (defun pmail-quit () "Quit out of PMAIL. Hook `pmail-quit-hook' is run after expunging." (interactive) + ;; Determine if the buffers need to be swapped. + (pmail-swap-buffers-maybe) (pmail-expunge-and-save) (when (boundp 'pmail-quit-hook) (run-hooks 'pmail-quit-hook)) @@ -1341,7 +1475,6 @@ (quit-window) (replace-buffer-in-windows obuf)))) -;;; mbox: ready (defun pmail-bury () "Bury current Pmail buffer and its summary buffer." (interactive) @@ -1355,8 +1488,6 @@ (bury-buffer pmail-summary-buffer))) (quit-window))) -;;;??? Fails to add descriptor for new message. -;;; mbox: ready (defun pmail-duplicate-message () "Create a duplicated copy of the current message. The duplicate copy goes into the Pmail file just after the @@ -1365,10 +1496,11 @@ (widen) (let ((buffer-read-only nil) (number pmail-current-message) - (string (buffer-substring (pmail-desc-get-start pmail-current-message) - (pmail-desc-get-end pmail-current-message)))) - (goto-char (pmail-desc-get-end pmail-current-message)) + (string (buffer-substring (pmail-msgbeg pmail-current-message) + (pmail-msgend pmail-current-message)))) + (goto-char (pmail-msgend pmail-current-message)) (insert string) + (pmail-forget-messages) (pmail-show-message number) (message "Message duplicated"))) @@ -1378,9 +1510,11 @@ (interactive "FRun pmail on PMAIL file: ") (pmail filename)) + ;; This used to scan subdirectories recursively, but someone pointed out ;; that if the user wants that, person can put all the files in one dir. -;; And the recursive scan was slow. So I took it out. rms, Sep 1996. +;; And the recursive scan was slow. So I took it out. +;; rms, Sep 1996. (defun pmail-find-all-files (start) "Return list of file in dir START that match `pmail-secondary-file-regexp'." (if (file-accessible-directory-p start) @@ -1437,7 +1571,7 @@ (cons "Output Pmail File" (pmail-list-to-menu "Output Pmail File" files - 'pmail-output)))) + 'pmail-output-to-pmail-file)))) (define-key pmail-mode-map [menu-bar classify input-menu] '("Input Pmail File" . pmail-disable-menu)) @@ -1447,8 +1581,8 @@ ;;;; *** Pmail input *** -(declare-function pmail-summary-goto-msg "pmailsum" - (&optional n nowarn skip-pmail)) +(declare-function pmail-spam-filter "pmail-spam-filter" (msg)) +(declare-function pmail-summary-goto-msg "pmailsum" (&optional n nowarn skip-pmail)) (declare-function pmail-summary-mark-undeleted "pmailsum" (n)) (declare-function pmail-summary-mark-deleted "pmailsum" (&optional n undel)) (declare-function rfc822-addresses "rfc822" (header-text)) @@ -1456,141 +1590,196 @@ (declare-function mail-sendmail-delimit-header "sendmail" ()) (declare-function mail-header-end "sendmail" ()) -(defun pmail-get-inbox-files () - "Return all files from `pmail-inbox-list' without name conflicts. -A conflict happens when two inbox file names have the same name -according to `file-name-nondirectory'." - (let (files last-names) - (catch 'conflict - (dolist (file pmail-inbox-list) - (if (member (file-name-nondirectory file) last-names) - (throw 'conflict t) - (push file files)) - (push (file-name-nondirectory file) last-names))) - (nreverse files))) - -(defun pmail-delete-inbox-files (files) - "Delete all files given in FILES. -If delete fails, truncate them to zero length." - (dolist (file files) - (condition-case nil - ;; First, try deleting. - (condition-case nil - (delete-file file) - ;; If we can't delete it, truncate it. - (file-error (write-region (point) (point) file))) - (file-error nil)))) - -(autoload 'rmail-spam-filter "rmail-spam-filter") +;; RLK feature not added in this version: +;; argument specifies inbox file or files in various ways. (defun pmail-get-new-mail (&optional file-name) - "Move any new mail from this mail file's inbox files. -The inbox files for the primary mail file are determined using -various means when setting up the buffer. The list of inbox -files are stored in `pmail-inbox-list'. - -The most important variable that determines the value of this -list is `pmail-inbox-alist' which lists the inbox files for any -mail files you might be using. - -If the above yields no inbox files, and if this is the primary -mail file as determined by `pmail-file-name', the inbox lists -otherwise defaults to `pmail-primary-inbox-list' if set, or the -environment variable MAIL if set, or the user's mail file in -`rmail-spool-directory'. - -This is why, by default, no mail file has inbox files, except for -the primary mail file ~/PMAIL, which gets its new mail from the -mail spool. - -You can also specify the file to get new mail from interactively. -A prefix argument will read a file name and use that file as the -inbox. Noninteractively, you can pass the inbox file name as an -argument. + "Move any new mail from this PMAIL file's inbox files. +The inbox files can be specified with the file's Mail: option. The +variable `pmail-primary-inbox-list' specifies the inboxes for your +primary PMAIL file if it has no Mail: option. By default, this is +your /usr/spool/mail/$USER. + +You can also specify the file to get new mail from. In this case, the +file of new mail is not changed or deleted. Noninteractively, you can +pass the inbox file name as an argument. Interactively, a prefix +argument causes us to read a file name and use that file as the inbox. If the variable `pmail-preserve-inbox' is non-nil, new mail will always be left in inbox files rather than deleted. -This function runs `pmail-get-new-mail-hook' before saving the -updated file. It returns t if it got any new messages." +This function runs `pmail-get-new-mail-hook' before saving the updated file. +It returns t if it got any new messages." (interactive - (list (when current-prefix-arg - (read-file-name "Get new mail from file: ")))) + (list (if current-prefix-arg + (read-file-name "Get new mail from file: ")))) (run-hooks 'pmail-before-get-new-mail-hook) - ;; If the disk file has been changed from under us, revert to it - ;; before we get new mail. - (unless (verify-visited-file-modtime (current-buffer)) - (find-file (buffer-file-name))) - (with-current-buffer pmail-buffer - (widen) - ;; Get rid of all undo records for this buffer. - (unless (eq buffer-undo-list t) + ;; If the disk file has been changed from under us, + ;; revert to it before we get new mail. + (or (verify-visited-file-modtime (current-buffer)) + (find-file (buffer-file-name))) + (set-buffer pmail-buffer) + (pmail-maybe-set-message-counters) + (widen) + ;; Get rid of all undo records for this buffer. + (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) - (let ((pmail-enable-multibyte (default-value 'enable-multibyte-characters)) - ;; If buffer has not changed yet, and has not been saved yet, - ;; don't replace the old backup file now. - (make-backup-files (and make-backup-files (buffer-modified-p))) - current-message found) - (condition-case nil - (let ((buffer-read-only nil) - (buffer-undo-list t) - (delete-files nil) - (new-messages 0) - (rsf-number-of-spam 0)) - (save-excursion - (save-restriction - (goto-char (point-max)) - (narrow-to-region (point) (point)) - ;; Read in the contents of the inbox files, renaming - ;; them as necessary, and adding to the list of files to - ;; delete eventually. - (if file-name - (pmail-insert-inbox-text (list file-name) nil) - (setq delete-files (pmail-insert-inbox-text - (pmail-get-inbox-files) t))) - ;; Process newly found messages and save them into the - ;; PMAIL file. - (unless (equal (point-min) (point-max)) - (setq new-messages (pmail-convert-mbox-format)) - (unless (zerop new-messages) - (pmail-process-new-messages) - (setq pmail-current-message (1+ pmail-total-messages) - pmail-total-messages (pmail-desc-get-count))) - (save-buffer)) - ;; Delete the old files, now that the PMAIL file is - ;; saved. - (when delete-files - (pmail-delete-inbox-files delete-files)))) - - (if (zerop new-messages) - (when (or file-name pmail-inbox-list) - (pmail-show-message) - (message "(No new mail has arrived)")) - - ;; Process the new messages for spam using the integrated - ;; spam filter. The spam filter can mark messages for - ;; deletion and can output a message. - (setq current-message (pmail-first-unseen-message)) - (when pmail-use-spam-filter - (while (<= current-message pmail-total-messages) - (rmail-spam-filter current-message) - (setq current-message (1+ current-message)))) - ;; Make the first unseen message the current message and - ;; update the summary buffer, if one exists. - (setq current-message (pmail-first-unseen-message)) - (if (pmail-summary-exists) - (with-current-buffer pmail-summary-buffer - (pmail-update-summary) - (pmail-summary-goto-msg current-message)) - (pmail-show-message current-message)) - ;; Run the after get new mail hook. - (run-hooks 'pmail-after-get-new-mail-hook) - (message "%d new message%s read" - new-messages (if (= 1 new-messages) "" "s")) - (setq found t)) - found) - ;; Don't leave the buffer screwed up if we get a disk-full error. - (file-error (or found (pmail-show-message))))))) + (let ((all-files (if file-name (list file-name) + pmail-inbox-list)) + (pmail-enable-multibyte (default-value 'enable-multibyte-characters)) + found) + (unwind-protect + (progn + (while all-files + (let ((opoint (point)) + (new-messages 0) + (rsf-number-of-spam 0) + (delete-files ()) + ;; If buffer has not changed yet, and has not been saved yet, + ;; don't replace the old backup file now. + (make-backup-files (and make-backup-files (buffer-modified-p))) + (buffer-read-only nil) + ;; Don't make undo records for what we do in getting mail. + (buffer-undo-list t) + success + ;; Files to insert this time around. + files + ;; Last names of those files. + file-last-names) + ;; Pull files off all-files onto files + ;; as long as there is no name conflict. + ;; A conflict happens when two inbox file names + ;; have the same last component. + (while (and all-files + (not (member (file-name-nondirectory (car all-files)) + file-last-names))) + (setq files (cons (car all-files) files) + file-last-names + (cons (file-name-nondirectory (car all-files)) files)) + (setq all-files (cdr all-files))) + ;; Put them back in their original order. + (setq files (nreverse files)) + + (goto-char (point-max)) + (skip-chars-backward " \t\n") ; just in case of brain damage + (delete-region (point) (point-max)) ; caused by require-final-newline + (save-excursion + (save-restriction + (narrow-to-region (point) (point)) + ;; Read in the contents of the inbox files, + ;; renaming them as necessary, + ;; and adding to the list of files to delete eventually. + (if file-name + (pmail-insert-inbox-text files nil) + (setq delete-files (pmail-insert-inbox-text files t))) + ;; Scan the new text and convert each message to mbox format. + (goto-char (point-min)) + (unwind-protect + (save-excursion + (setq new-messages (pmail-add-babyl-headers) + success t)) + ;; Try to delete the garbage just inserted. + (or success (delete-region (point-min) (point-max))) + ;; If we could not convert the file's inboxes, + ;; rename the files we tried to read + ;; so we won't over and over again. + (if (and (not file-name) (not success)) + (let ((delfiles delete-files) + (count 0)) + (while delfiles + (while (file-exists-p (format "PMAILOSE.%d" count)) + (setq count (1+ count))) + (rename-file (car delfiles) + (format "PMAILOSE.%d" count)) + (setq delfiles (cdr delfiles)))))) + (or (zerop new-messages) + (let (success) + (goto-char (point-min)) + (pmail-count-new-messages) + (run-hooks 'pmail-get-new-mail-hook) + (save-buffer))) + ;; Delete the old files, now that babyl file is saved. + (while delete-files + (condition-case () + ;; First, try deleting. + (condition-case () + (delete-file (car delete-files)) + (file-error + ;; If we can't delete it, truncate it. + (write-region (point) (point) (car delete-files)))) + (file-error nil)) + (setq delete-files (cdr delete-files))))) + (if (= new-messages 0) + (progn (goto-char opoint) + (if (or file-name pmail-inbox-list) + (message "(No new mail has arrived)"))) + ;; check new messages to see if any of them is spam: + (if (and (featurep 'pmail-spam-filter) + pmail-use-spam-filter) + (let* + ((old-messages (- pmail-total-messages new-messages)) + (rsf-scanned-message-number (1+ old-messages)) + ;; save deletion flags of old messages: vector starts + ;; at zero (is one longer that no of messages), + ;; therefore take 1+ old-messages + (save-deleted + (substring pmail-deleted-vector 0 (1+ + old-messages)))) + ;; set all messages to undeleted + (setq pmail-deleted-vector + (make-string (1+ pmail-total-messages) ?\ )) + (while (<= rsf-scanned-message-number + pmail-total-messages) + (progn + (if (not (pmail-spam-filter rsf-scanned-message-number)) + (progn (setq rsf-number-of-spam (1+ rsf-number-of-spam))) + ) + (setq rsf-scanned-message-number (1+ rsf-scanned-message-number)) + )) + (if (> rsf-number-of-spam 0) + (progn + (when (pmail-expunge-confirmed) + (pmail-only-expunge t)) + )) + (setq pmail-deleted-vector + (concat + save-deleted + (make-string (- pmail-total-messages old-messages) + ?\ ))) + )) + (if (pmail-summary-exists) + (pmail-select-summary + (pmail-update-summary))) + (message "%d new message%s read%s" + new-messages (if (= 1 new-messages) "" "s") + ;; print out a message on number of spam messages found: + (if (and (featurep 'pmail-spam-filter) + pmail-use-spam-filter + (> rsf-number-of-spam 0)) + (cond ((= 1 new-messages) + ", and appears to be spam") + ((= rsf-number-of-spam new-messages) + ", and all appear to be spam") + ((> rsf-number-of-spam 1) + (format ", and %d appear to be spam" + rsf-number-of-spam)) + (t + ", and 1 appears to be spam")) + "")) + (when (and (featurep 'pmail-spam-filter) + pmail-use-spam-filter + (> rsf-number-of-spam 0)) + (if rsf-beep (beep t)) + (sleep-for rsf-sleep-after-message)) + + ;; Move to the first new message + ;; unless we have other unseen messages before it. + (pmail-show-message (pmail-first-unseen-message)) + (run-hooks 'pmail-after-get-new-mail-hook) + (setq found t)))) + found) + ;; Don't leave the buffer screwed up if we get a disk-full error. + (or found (pmail-show-message))))) (defun pmail-parse-url (file) "Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD) @@ -1613,8 +1802,11 @@ (when pmail-remote-password-required (setq got-password (not (pmail-have-password))) (setq supplied-password (pmail-get-remote-password - (string-equal proto "imap"))))) - + (string-equal proto "imap")))) + ;; The password is embedded. Strip it out since movemail + ;; does not really like it, in spite of the movemail spec. + (setq file (concat proto "://" user "@" host))) + (if (pmail-movemail-variant-p 'emacs) (if (string-equal proto "pop") (list (concat "po:" user ":" host) @@ -1622,7 +1814,7 @@ (or pass supplied-password) got-password) (error "Emacs movemail does not support %s protocol" proto)) - (list (concat proto "://" user "@" host) + (list file (or (string-equal proto "pop") (string-equal proto "imap")) (or supplied-password pass) got-password)))) @@ -1680,13 +1872,12 @@ (expand-file-name buffer-file-name)))) ;; Always use movemail to rename the file, ;; since there can be mailboxes in various directories. - (if (not popmail) - (progn - ;; On some systems, /usr/spool/mail/foo is a directory - ;; and the actual inbox is /usr/spool/mail/foo/foo. - (if (file-directory-p file) - (setq file (expand-file-name (user-login-name) - file))))) + (when (not popmail) + ;; On some systems, /usr/spool/mail/foo is a directory + ;; and the actual inbox is /usr/spool/mail/foo/foo. + (if (file-directory-p file) + (setq file (expand-file-name (user-login-name) + file)))) (cond (popmail (message "Getting mail from the remote server ...")) ((and (file-exists-p tofile) @@ -1761,6 +1952,18 @@ size) (goto-char (point-max)) (setq size (nth 1 (insert-file-contents tofile))) + ;; Determine if a pair of newline message separators need + ;; to be added to the new collection of messages. This is + ;; the case for all new message collections added to a + ;; non-empty mail file. + (unless (zerop size) + (save-restriction + (let ((start (point-min))) + (widen) + (unless (eq start (point-min)) + (goto-char start) + (insert "\n\n") + (setq size (+ 2 size)))))) (goto-char (point-max)) (or (= (preceding-char) ?\n) (zerop size) @@ -1770,110 +1973,482 @@ (message "") (setq files (cdr files))) delete-files)) - -;;;; *** Pmail message decoding *** - -;; these two are unused, and possibly harmul. - -;; (defun pmail-decode-region (from to coding) -;; "Decode the region specified by FROM and TO by CODING. -;; If CODING is nil or an invalid coding system, decode by `undecided'." -;; (unless (and coding (coding-system-p coding)) -;; (setq coding 'undecided)) -;; ;; Use -dos decoding, to remove ^M characters left from base64 or -;; ;; rogue qp-encoded text. -;; (decode-coding-region from to -;; (coding-system-change-eol-conversion -;; coding 'dos)) -;; ;; Don't reveal the fact we used -dos decoding, as users generally -;; ;; will not expect the PMAIL buffer to use DOS EOL format. -;; (setq buffer-file-coding-system -;; (setq last-coding-system-used -;; (coding-system-change-eol-conversion -;; coding 'unix)))) - -;; (defun pmail-decode-by-content-type (from to) -;; "Decode message between FROM and TO according to Content-Type." -;; (when (and (not pmail-enable-mime) pmail-enable-multibyte) -;; (let ((coding-system-used nil) -;; (case-fold-search t)) -;; (save-restriction -;; (narrow-to-region from to) -;; (when (and (not pmail-enable-mime) pmail-enable-multibyte) -;; (let ((coding -;; (when (save-excursion -;; (goto-char (pmail-header-get-limit)) -;; (re-search-backward -;; pmail-mime-charset-pattern -;; (point-min) t)) -;; (intern (downcase (match-string 1)))))) -;; (setq coding-system-used (pmail-decode-region -;; (point-min) (point-max) -;; coding))))) -;; (setq last-coding-system-used coding-system-used)))) + +;; Decode the region specified by FROM and TO by CODING. +;; If CODING is nil or an invalid coding system, decode by `undecided'. +(defun pmail-decode-region (from to coding) + (if (or (not coding) (not (coding-system-p coding))) + (setq coding 'undecided)) + ;; Use -dos decoding, to remove ^M characters left from base64 or + ;; rogue qp-encoded text. + (decode-coding-region from to + (coding-system-change-eol-conversion coding 1)) + ;; Don't reveal the fact we used -dos decoding, as users generally + ;; will not expect the PMAIL buffer to use DOS EOL format. + (setq buffer-file-coding-system + (setq last-coding-system-used + (coding-system-change-eol-conversion coding 0)))) + +(defun pmail-add-babyl-headers () + "Validate the RFC2822 format for the new messages. Point, at +entry should be looking at the first new message. An error will +be thrown if the new messages are not RCC2822 compliant. Lastly, +unless one already exists, add an Rmail attribute header to the +new messages in the region " + (let ((count 0) + (start (point)) + limit) + ;; Detect an empty inbox file. + (unless (= start (point-max)) + ;; Scan the new messages to establish a count and to insure that + ;; an attribute header is present. + (while (looking-at "From ") + ;; Determine if a new attribute header needs to be added to + ;; the message. + (if (search-forward "\n\n" nil t) + (progn + (setq count (1+ count)) + (forward-char -1) + (narrow-to-region start (point)) + (unless (mail-fetch-field pmail-attribute-header) + (insert pmail-attribute-header ": ------U\n")) + (widen)) + (error "Invalid mbox format detected in inbox file")) + ;; Move to the next message. + (if (search-forward "\n\nFrom " nil 'move) + (forward-char -5)) + (setq start (point)))) + count)) + +;; the pmail-break-forwarded-messages feature is not implemented +(defun pmail-convert-to-babyl-format () + (let ((count 0) start + (case-fold-search nil) + (buffer-undo-list t) + (invalid-input-resync + (function (lambda () + (message "Invalid Babyl format in inbox!") + (sit-for 3) + ;; Try to get back in sync with a real message. + (if (re-search-forward + (concat pmail-mmdf-delim1 "\\|^From") nil t) + (beginning-of-line) + (goto-char (point-max))))))) + (goto-char (point-min)) + (save-restriction + (while (not (eobp)) + (setq start (point)) + (cond ((looking-at "BABYL OPTIONS:") ;Babyl header + (if (search-forward "\n\^_" nil t) + ;; If we find the proper terminator, delete through there. + (delete-region (point-min) (point)) + (funcall invalid-input-resync) + (delete-region (point-min) (point)))) + ;; Babyl format message + ((looking-at "\^L") + (or (search-forward "\n\^_" nil t) + (funcall invalid-input-resync)) + (setq count (1+ count)) + ;; Make sure there is no extra white space after the ^_ + ;; at the end of the message. + ;; Narrowing will make sure that whatever follows the junk + ;; will be treated properly. + (delete-region (point) + (save-excursion + (skip-chars-forward " \t\n") + (point))) + ;; The following let* form was wrapped in a `save-excursion' + ;; which in one case caused infinite looping, see: + ;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00968.html + ;; Removing that form leaves `point' at the end of the + ;; region decoded by `pmail-decode-region' which should + ;; be correct. + (let* ((header-end + (progn + (save-excursion + (goto-char start) + (forward-line 1) + (if (looking-at "0") + (forward-line 1) + (forward-line 2)) + (save-restriction + (narrow-to-region (point) (point-max)) + (rfc822-goto-eoh) + (point))))) + (case-fold-search t) + (quoted-printable-header-field-end + (save-excursion + (goto-char start) + (re-search-forward + "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" + header-end t))) + (base64-header-field-end + (save-excursion + (goto-char start) + ;; Don't try to decode non-text data. + (and (re-search-forward + "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" + header-end t) + (goto-char start) + (re-search-forward + "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" + header-end t))))) + (if quoted-printable-header-field-end + (save-excursion + (unless + (mail-unquote-printable-region header-end (point) nil t t) + (message "Malformed MIME quoted-printable message")) + ;; Change "quoted-printable" to "8bit", + ;; to reflect the decoding we just did. + (goto-char quoted-printable-header-field-end) + (delete-region (point) (search-backward ":")) + (insert ": 8bit"))) + (if base64-header-field-end + (save-excursion + (when + (condition-case nil + (progn + (base64-decode-region (1+ header-end) + (- (point) 2)) + t) + (error nil)) + ;; Change "base64" to "8bit", to reflect the + ;; decoding we just did. + (goto-char base64-header-field-end) + (delete-region (point) (search-backward ":")) + (insert ": 8bit")))) + (setq last-coding-system-used nil) + (or pmail-enable-mime + (not pmail-enable-multibyte) + (let ((mime-charset + (if (and pmail-decode-mime-charset + (save-excursion + (goto-char start) + (search-forward "\n\n" nil t) + (let ((case-fold-search t)) + (re-search-backward + pmail-mime-charset-pattern + start t)))) + (intern (downcase (match-string 1)))))) + (pmail-decode-region start (point) mime-charset)))) + ;; Add an X-Coding-System: header if we don't have one. + (save-excursion + (goto-char start) + (forward-line 1) + (if (looking-at "0") + (forward-line 1) + (forward-line 2)) + (or (save-restriction + (narrow-to-region (point) (point-max)) + (rfc822-goto-eoh) + (goto-char (point-min)) + (re-search-forward "^X-Coding-System:" nil t)) + (insert "X-Coding-System: " + (symbol-name last-coding-system-used) + "\n"))) + (narrow-to-region (point) (point-max)) + (and (= 0 (% count 10)) + (message "Converting to Babyl format...%d" count))) + ;;*** MMDF format + ((let ((case-fold-search t)) + (looking-at pmail-mmdf-delim1)) + (let ((case-fold-search t)) + (replace-match "\^L\n0, unseen,,\n*** EOOH ***\n") + (re-search-forward pmail-mmdf-delim2 nil t) + (replace-match "\^_")) + (save-excursion + (save-restriction + (narrow-to-region start (1- (point))) + (goto-char (point-min)) + (while (search-forward "\n\^_" nil t) ; single char "\^_" + (replace-match "\n^_")))) ; 2 chars: "^" and "_" + (setq last-coding-system-used nil) + (or pmail-enable-mime + (not pmail-enable-multibyte) + (decode-coding-region start (point) 'undecided)) + (save-excursion + (goto-char start) + (forward-line 3) + (insert "X-Coding-System: " + (symbol-name last-coding-system-used) + "\n")) + (narrow-to-region (point) (point-max)) + (setq count (1+ count)) + (and (= 0 (% count 10)) + (message "Converting to Babyl format...%d" count))) + ;;*** Mail format + ((looking-at "^From ") + (insert "\^L\n0, unseen,,\n*** EOOH ***\n") + (pmail-nuke-pinhead-header) + ;; If this message has a Content-Length field, + ;; skip to the end of the contents. + (let* ((header-end (save-excursion + (and (re-search-forward "\n\n" nil t) + (1- (point))))) + (case-fold-search t) + (quoted-printable-header-field-end + (save-excursion + (re-search-forward + "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*" + header-end t))) + (base64-header-field-end + (and + ;; Don't decode non-text data. + (save-excursion + (re-search-forward + "^content-type:\\(\n?[\t ]\\)\\(text\\|message\\)/" + header-end t)) + (save-excursion + (re-search-forward + "^content-transfer-encoding:\\(\n?[\t ]\\)*base64\\(\n?[\t ]\\)*" + header-end t)))) + (size + ;; Get the numeric value from the Content-Length field. + (save-excursion + ;; Back up to end of prev line, + ;; in case the Content-Length field comes first. + (forward-char -1) + (and (search-forward "\ncontent-length: " + header-end t) + (let ((beg (point)) + (eol (progn (end-of-line) (point)))) + (string-to-number (buffer-substring beg eol))))))) + (and size + (if (and (natnump size) + (<= (+ header-end size) (point-max)) + ;; Make sure this would put us at a position + ;; that we could continue from. + (save-excursion + (goto-char (+ header-end size)) + (skip-chars-forward "\n") + (or (eobp) + (and (looking-at "BABYL OPTIONS:") + (search-forward "\n\^_" nil t)) + (and (looking-at "\^L") + (search-forward "\n\^_" nil t)) + (let ((case-fold-search t)) + (looking-at pmail-mmdf-delim1)) + (looking-at "From ")))) + (goto-char (+ header-end size)) + (message "Ignoring invalid Content-Length field") + (sit-for 1 0 t))) + (if (let ((case-fold-search nil)) + (re-search-forward + (concat "^[\^_]?\\(" + pmail-unix-mail-delimiter + "\\|" + pmail-mmdf-delim1 "\\|" + "^BABYL OPTIONS:\\|" + "\^L\n[01],\\)") nil t)) + (goto-char (match-beginning 1)) + (goto-char (point-max))) + (setq count (1+ count)) + (if quoted-printable-header-field-end + (save-excursion + (unless + (mail-unquote-printable-region header-end (point) nil t t) + (message "Malformed MIME quoted-printable message")) + ;; Change "quoted-printable" to "8bit", + ;; to reflect the decoding we just did. + (goto-char quoted-printable-header-field-end) + (delete-region (point) (search-backward ":")) + (insert ": 8bit"))) + (if base64-header-field-end + (save-excursion + (when + (condition-case nil + (progn + (base64-decode-region + (1+ header-end) + (save-excursion + ;; Prevent base64-decode-region + ;; from removing newline characters. + (skip-chars-backward "\n\t ") + (point))) + t) + (error nil)) + ;; Change "base64" to "8bit", to reflect the + ;; decoding we just did. + (goto-char base64-header-field-end) + (delete-region (point) (search-backward ":")) + (insert ": 8bit"))))) + + (save-excursion + (save-restriction + (narrow-to-region start (point)) + (goto-char (point-min)) + (while (search-forward "\n\^_" nil t) ; single char + (replace-match "\n^_")))) ; 2 chars: "^" and "_" + ;; This is for malformed messages that don't end in newline. + ;; There shouldn't be any, but some users say occasionally + ;; there are some. + (or (bolp) (newline)) + (insert ?\^_) + (setq last-coding-system-used nil) + (or pmail-enable-mime + (not pmail-enable-multibyte) + (let ((mime-charset + (if (and pmail-decode-mime-charset + (save-excursion + (goto-char start) + (search-forward "\n\n" nil t) + (let ((case-fold-search t)) + (re-search-backward + pmail-mime-charset-pattern + start t)))) + (intern (downcase (match-string 1)))))) + (pmail-decode-region start (point) mime-charset))) + (save-excursion + (goto-char start) + (forward-line 3) + (insert "X-Coding-System: " + (symbol-name last-coding-system-used) + "\n")) + (narrow-to-region (point) (point-max)) + (and (= 0 (% count 10)) + (message "Converting to Babyl format...%d" count))) + ;; + ;; This kludge is because some versions of sendmail.el + ;; insert an extra newline at the beginning that shouldn't + ;; be there. sendmail.el has been fixed, but old versions + ;; may still be in use. -- rms, 7 May 1993. + ((eolp) (delete-char 1)) + (t (error "Cannot convert to babyl format"))))) + (setq buffer-undo-list nil) + count)) + +;; Delete the "From ..." line, creating various other headers with +;; information from it if they don't already exist. Now puts the +;; original line into a mail-from: header line for debugging and for +;; use by the pmail-output function. +(defun pmail-nuke-pinhead-header () + (save-excursion + (save-restriction + (let ((start (point)) + (end (progn + (condition-case () + (search-forward "\n\n") + (error + (goto-char (point-max)) + (insert "\n\n"))) + (point))) + has-from has-date) + (narrow-to-region start end) + (let ((case-fold-search t)) + (goto-char start) + (setq has-from (search-forward "\nFrom:" nil t)) + (goto-char start) + (setq has-date (and (search-forward "\nDate:" nil t) (point))) + (goto-char start)) + (let ((case-fold-search nil)) + (if (re-search-forward (concat "^" pmail-unix-mail-delimiter) nil t) + (replace-match + (concat + "Mail-from: \\&" + ;; Keep and reformat the date if we don't + ;; have a Date: field. + (if has-date + "" + (concat + "Date: \\2, \\4 \\3 \\9 \\5 " + + ;; The timezone could be matched by group 7 or group 10. + ;; If neither of them matched, assume EST, since only + ;; Easterners would be so sloppy. + ;; It's a shame the substitution can't use "\\10". + (cond + ((/= (match-beginning 7) (match-end 7)) "\\7") + ((/= (match-beginning 10) (match-end 10)) + (buffer-substring (match-beginning 10) + (match-end 10))) + (t "EST")) + "\n")) + ;; Keep and reformat the sender if we don't + ;; have a From: field. + (if has-from + "" + "From: \\1\n")) + t))))))) ;;;; *** Pmail Message Formatting and Header Manipulation *** -(defun pmail-clear-headers (&optional ignored-headers) - "Delete all header fields that Pmail should not show. -If the optional argument IGNORED-HEADERS is non-nil, -delete all header fields whose names match that regexp. -Otherwise, if `pmail-displayed-headers' is non-nil, -delete all header fields *except* those whose names match that regexp. -Otherwise, delete all header fields whose names match `pmail-ignored-headers' -unless they also match `pmail-nonignored-headers'." - (when (search-forward "\n\n" nil t) - (forward-char -1) - (let ((case-fold-search t) - (buffer-read-only nil)) - (if (and pmail-displayed-headers (null ignored-headers)) - (save-restriction - (narrow-to-region (point-min) (point)) - (let (lim next) - (goto-char (point-min)) - (while (and (not (eobp)) - (save-excursion - (if (re-search-forward "\n[^ \t]" nil t) - (setq lim (match-beginning 0) - next (1+ lim)) - (setq lim nil next (point-max))))) - (if (save-excursion - (re-search-forward pmail-displayed-headers lim t)) - (goto-char next) - (delete-region (point) next)))) - (goto-char (point-min))) - (or ignored-headers (setq ignored-headers pmail-ignored-headers)) +(defun pmail-copy-headers (beg end &optional ignored-headers) + "Copy displayed header fields to the message viewer buffer. +BEG and END marks the start and end positions of the message in +the mail buffer. If the optional argument IGNORED-HEADERS is +non-nil, ignore all header fields whose names match that regexp. +Otherwise, if `rmail-displayed-headers' is non-nil, copy only +those header fields whose names match that regexp. Otherwise, +copy all header fields whose names do not match +`rmail-ignored-headers' (unless they also match +`rmail-nonignored-headers')." + (let ((result "") + (header-start-regexp "\n[^ \t]") + lim) + (with-current-buffer pmail-buffer + (when (search-forward "\n\n" nil t) + (forward-char -1) (save-restriction - (narrow-to-region (point-min) (point)) + ;; Put point right after the From header line. + (narrow-to-region beg (point)) (goto-char (point-min)) - (while (and ignored-headers - (re-search-forward ignored-headers nil t)) - (beginning-of-line) - (if (and pmail-nonignored-headers - (looking-at pmail-nonignored-headers)) - (forward-line 1) - (delete-region (point) - (save-excursion - (if (re-search-forward "\n[^ \t]" nil t) - (1- (point)) - (point-max))))))))))) - -(defun pmail-msg-is-pruned (&optional msg) - "Determine if the headers for the current message are being - displayed. If MSG is non-nil it will be used as the message number - instead of the current message." - (pmail-desc-get-header-display-state (or msg pmail-current-message))) + (unless (re-search-forward header-start-regexp nil t) + (error "Invalid mbox format; no header follows the From message separator.")) + (forward-char -1) + (cond + ;; Handle the case where all headers should be copied. + ((eq pmail-header-style 'full) + (setq result (buffer-substring beg (point-max)))) + ;; Handle the case where the headers matching the diplayed + ;; headers regexp should be copied. + ((and pmail-displayed-headers (null ignored-headers)) + (while (not (eobp)) + (save-excursion + (setq lim (if (re-search-forward header-start-regexp nil t) + (1+ (match-beginning 0)) + (point-max)))) + (when (looking-at pmail-displayed-headers) + (setq result (concat result (buffer-substring (point) lim)))) + (goto-char lim))) + ;; Handle the ignored headers. + ((or ignored-headers (setq ignored-headers pmail-ignored-headers)) + (while (and ignored-headers (not (eobp))) + (save-excursion + (setq lim (if (re-search-forward header-start-regexp nil t) + (1+ (match-beginning 0)) + (point-max)))) + (if (and (looking-at ignored-headers) + (not (looking-at pmail-nonignored-headers))) + (goto-char lim) + (setq result (concat result (buffer-substring (point) lim))) + (goto-char lim)))) + (t (error "No headers selected for display!")))))) + result)) + +(defun pmail-copy-body (beg end) + "Return the message body to be displayed in the view buffer. +BEG and END marks the start and end positions of the message in +the mail buffer." + (with-current-buffer pmail-buffer + (if (search-forward "\n\n" nil t) + (buffer-substring (point) end) + (error "Invalid message format: no header/body separator")))) (defun pmail-toggle-header (&optional arg) "Show original message header if pruned header currently shown, or vice versa. With argument ARG, show the message header pruned if ARG is greater than zero; otherwise, show it in full." (interactive "P") - (pmail-header-toggle-visibility arg)) + (setq pmail-header-style + (cond + ((and (numberp arg) (> arg 0)) 'normal) + ((eq pmail-header-style 'full) 'normal) + (t 'full))) + (pmail-show-message)) ;; Lifted from repos-count-screen-lines. +;; Return number of screen lines between START and END. (defun pmail-count-screen-lines (start end) - "Return number of screen lines between START and END." (save-excursion (save-restriction (narrow-to-region start end) @@ -1882,22 +2457,64 @@ ;;;; *** Pmail Attributes and Keywords *** -;; Make a string describing the current message's attributes by -;; keywords and set it up as the name of a minor mode so it will -;; appear in the mode line. +(defun pmail-get-header (name &optional msg) + "Return the value of message header NAME, nil if no such header +exists. MSG, if set identifies the message number to use. The +current mail message will be used otherwise." + (save-excursion + (save-restriction + (with-current-buffer pmail-buffer + (widen) + (let* ((n (or msg pmail-current-message)) + (beg (pmail-msgbeg n)) + end) + (goto-char beg) + (setq end (search-forward "\n\n" nil t)) + (if end + (progn + (narrow-to-region beg end) + (mail-fetch-field name)) + (error "Invalid mbox format encountered."))))))) + +(defun pmail-get-attr-names (&optional msg) + "Return the message attributes in a comma separated string. +MSG, if set identifies the message number to use. The current +mail message will be used otherwise." + (let ((value (pmail-get-header pmail-attribute-field-name msg)) + result temp) + (dotimes (index (length value)) + (setq temp (and (not (= ?- (aref value index))) + (nth 1 (aref pmail-attr-array index))) + result + (cond + ((and temp result) (format "%s, %s" result temp)) + (temp temp) + (t result)))) + result)) + +(defun pmail-get-keywords (&optional msg) + "Return the message keywords in a comma separated string. +MSG, if set identifies the message number to use. The current +mail message will be used otherwise." + (pmail-get-header pmail-keyword-header msg)) + (defun pmail-display-labels () - (let (keyword-list result) - ;; Update the keyword list for the current message. - (if (> pmail-current-message 0) - (setq keyword-list (pmail-desc-get-keywords pmail-current-message))) - ;; Generate the result string. - (setq result (mapconcat 'identity keyword-list " ")) - ;; Update the mode line to display the keywords, the current - ;; message index and the total number of messages. + "Update the mode line with the (set) attributes and keywords +for the current message." + (let (blurb attr-names keywords) + ;; Combine the message attributes and keywords into a comma + ;; separated list. + (setq attr-names (pmail-get-attr-names pmail-current-message) + keywords (pmail-get-keywords pmail-current-message)) + (setq blurb + (cond + ((and attr-names keywords) (concat attr-names ", " keywords)) + (attr-names attr-names) + (keywords keywords) + (t ""))) (setq mode-line-process (format " %d/%d%s" - pmail-current-message pmail-total-messages - (if keyword-list (concat " " result) ""))) + pmail-current-message pmail-total-messages blurb)) ;; If pmail-enable-mime is non-nil, we may have to update ;; `mode-line-process' of pmail-view-buffer too. (if (and pmail-enable-mime @@ -1907,38 +2524,74 @@ (with-current-buffer pmail-view-buffer (setq mode-line-process mlp)))))) +(defun pmail-get-attr-value (attr state) + "Return the character value for ATTR. +ATTR is a (numberic) index, an offset into the mbox attribute +header value. STATE is one of nil, t, or a character value." + (cond + ((numberp state) state) + ((not state) ?-) + (t (nth 0 (aref pmail-attr-array attr))))) + (defun pmail-set-attribute (attr state &optional msgnum) - "Turn a attribute ATTR of a message on or off according to STATE. -ATTR is a string, MSGNUM is the optional message number. By -default, the current message is changed." + "Turn an attribute of a message on or off according to STATE. +STATE is either nil or the character (numeric) value associated +with the state (nil represents off and non-nil represents on). +ATTR is the index of the attribute. MSGNUM is message number to +change; nil means current message." + (set-buffer pmail-buffer) + (let ((value (pmail-get-attr-value attr state)) + (omax (point-max-marker)) + (omin (point-min-marker)) + (buffer-read-only nil) + limit) + (or msgnum (setq msgnum pmail-current-message)) + (if (> msgnum 0) + (unwind-protect + (save-excursion + ;; Determine if the current state is the desired state. + (widen) + (goto-char (pmail-msgbeg msgnum)) + (save-excursion + (setq limit (search-forward "\n\n" nil t))) + (when (search-forward (concat pmail-attribute-header ": ") limit t) + (forward-char attr) + (when (/= value (char-after)) + (delete-char 1) + (insert value))) + (if (= attr pmail-deleted-attr-index) + (pmail-set-message-deleted-p msgnum state))) + ;; Note: we don't use save-restriction because that does not work right + ;; if changes are made outside the saved restriction + ;; before that restriction is restored. + (narrow-to-region omin omax) + (set-marker omin nil) + (set-marker omax nil) + (if (= msgnum pmail-current-message) + (pmail-display-labels)))))) + +(defun pmail-message-attr-p (msg attrs) + "Return t if the attributes header for message MSG contains a +match for the regexp ATTRS." (save-excursion (save-restriction - (let ((attr-index (pmail-desc-get-attr-index attr))) - (set-buffer pmail-buffer) - (or msgnum (setq msgnum pmail-current-message)) - (pmail-desc-set-attribute msgnum attr-index state) - ;; Deal with the summary buffer. - (when pmail-summary-buffer - (pmail-summary-update msgnum)))))) - -(defun pmail-message-labels-p (n labels) - "Return t if message number N has keywords matching LABELS. -LABELS is a regular expression." - (catch 'found - (dolist (keyword (pmail-desc-get-keywords n)) - (when (string-match labels keyword) - (throw 'found t))))) - + (let ((start (pmail-msgbeg msg)) + limit) + (widen) + (goto-char start) + (setq limit (search-forward "\n\n" (pmail-msgend msg) t)) + (goto-char start) + (and limit + (search-forward (concat pmail-attribute-header ": ") limit t) + (looking-at attrs)))))) ;;;; *** Pmail Message Selection And Support *** +(defun pmail-msgend (n) + (marker-position (aref pmail-message-vector (1+ n)))) + (defun pmail-msgbeg (n) - (pmail-desc-get-start n)) -(make-obsolete 'pmail-msgbeg 'pmail-desc-get-start "22.0") - -(defun pmail-msgend (n) - (pmail-desc-get-end n)) -(make-obsolete 'pmail-msgend 'pmail-desc-get-end "22.0") + (marker-position (aref pmail-message-vector n))) (defun pmail-widen-to-current-msgbeg (function) "Call FUNCTION with point at start of internal data of current message. @@ -1951,132 +2604,145 @@ (save-excursion (unwind-protect (progn - (narrow-to-region (pmail-desc-get-start pmail-current-message) + (narrow-to-region (pmail-msgbeg pmail-current-message) (point-max)) (goto-char (point-min)) (funcall function)) ;; Note: we don't use save-restriction because that does not work right ;; if changes are made outside the saved restriction ;; before that restriction is restored. - (narrow-to-region (pmail-desc-get-start pmail-current-message) - (pmail-desc-get-end pmail-current-message))))) - -(defun pmail-process-new-messages (&optional nomsg) - "Process the new messages in the buffer. -The buffer has been narrowed to expose only the new messages. -For each new message append an entry to the message vector and, -if necessary, add a header that will capture the salient BABYL -information. Return the number of new messages. If NOMSG is -non-nil then do not show any progress messages." - (let ((inhibit-read-only t) - (case-fold-search nil) - (new-message-counter 0) - (start (point-max)) - end date keywords message-descriptor-list) - (or nomsg (message "Processing new messages...")) - ;; Process each message in turn starting from the back and - ;; proceeding to the front of the region. This is especially a - ;; good approach since the buffer will likely have new headers - ;; added. - (save-excursion - (goto-char start) - (while (re-search-backward pmail-unix-mail-delimiter nil t) - ;; Cache the message date to facilitate generating a message - ;; summary later. The format is '(DAY-OF-WEEK DAY-NUMBER MON - ;; YEAR TIME) - (setq date - (list (buffer-substring (match-beginning 2) (match-end 2)) - (buffer-substring (match-beginning 4) (match-end 4)) - (buffer-substring (match-beginning 3) (match-end 3)) - (buffer-substring (match-beginning 7) (match-end 7)) - (buffer-substring (match-beginning 5) (match-end 5)))) - ;;Set start and end to bracket this message. - (setq end start) - (setq start (point)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char start) - ;; Bump the new message counter. - (setq new-message-counter (1+ new-message-counter)) - - ;; Set up keywords, if any. The keywords are provided via a - ;; comma separated list and returned as a list of strings. - (setq keywords (pmail-header-get-keywords)) - (when keywords - ;; Keywords do exist. Register them with the keyword - ;; management library. - (pmail-register-keywords keywords)) - ;; Insure that we have From and Date headers. - ;;(pmail-decode-from-line) - ;; Perform User defined filtering. - (save-excursion - (if pmail-message-filter (funcall pmail-message-filter))) - ;; Accumulate the message attributes along with the message - ;; markers and the message date list. - (setq message-descriptor-list - (vconcat (list (list (point-min-marker) - (pmail-header-get-header - pmail-header-attribute-header) - keywords - date - (count-lines start end) - (cadr (mail-extract-address-components; does not like nil - (or (pmail-header-get-header "from") ""))) - (or (pmail-header-get-header "subject") - "none"))) - message-descriptor-list))))) - ;; Add the new message data lists to the Pmail message descriptor - ;; vector. - (pmail-desc-add-descriptors message-descriptor-list) - ;; Unless requested otherwise, show the number of new messages. - ;; Return the number of new messages. - (or nomsg (message "Processing new messages...done (%d)" - new-message-counter)) - new-message-counter))) - -(defun pmail-convert-mbox-format () - (let ((case-fold-search nil) - (message-count 0) - (start (point-max)) - end) - (save-excursion - (goto-char start) - (while (re-search-backward pmail-unix-mail-delimiter nil t) - (setq end start) - (setq start (point)) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - ;; Bump the new message counter. - (setq message-count (1+ message-count)) - ;; Detect messages that have been added with DOS line endings - ;; and convert the line endings for such messages. - (when (save-excursion (end-of-line) (= (preceding-char) ?\r)) - (let ((buffer-read-only nil) - (buffer-undo t) - (end-marker (copy-marker end))) - (message - "Processing new messages...(converting line endings)") - (save-excursion - (goto-char (point-max)) - (while (search-backward "\r\n" (point-min) t) - (delete-char 1))) - (setq end (marker-position end-marker)) - (set-marker end-marker nil))) - ;; Make sure we have an Pmail BABYL attribute header field. - ;; All we can assume is that the Pmail BABYL header field is - ;; in the header section. It's placement can be modified by - ;; another mailer. - (let ((attributes (pmail-header-get-header - pmail-header-attribute-header))) - (unless attributes - ;; No suitable header exists. Append the default BABYL - ;; data header for a new message. - (pmail-header-add-header pmail-header-attribute-header - pmail-desc-default-attrs)))))) - message-count))) + (narrow-to-region (pmail-msgbeg pmail-current-message) + (pmail-msgend pmail-current-message))))) + +(defun pmail-forget-messages () + (unwind-protect + (if (vectorp pmail-message-vector) + (let* ((i 0) + (v pmail-message-vector) + (n (length v))) + (while (< i n) + (move-marker (aref v i) nil) + (setq i (1+ i))))) + (setq pmail-message-vector nil) + (setq pmail-msgref-vector nil) + (setq pmail-deleted-vector nil))) + +(defun pmail-maybe-set-message-counters () + (if (not (and pmail-deleted-vector + pmail-message-vector + pmail-current-message + pmail-total-messages)) + (pmail-set-message-counters))) + +(defun pmail-count-new-messages (&optional nomsg) + "Count the number of new messages in the region. +Output a helpful message unless NOMSG is non-nil." + (let* ((case-fold-search nil) + (total-messages 0) + (messages-head nil) + (deleted-head nil)) + (or nomsg (message "Counting new messages...")) + (goto-char (point-max)) + ;; Put at the end of messages-head + ;; the entry for message N+1, which marks + ;; the end of message N. (N = number of messages). + (setq messages-head (list (point-marker))) + (pmail-set-message-counters-counter (point-min)) + (setq pmail-current-message (1+ pmail-total-messages)) + (setq pmail-total-messages + (+ pmail-total-messages total-messages)) + (setq pmail-message-vector + (vconcat pmail-message-vector (cdr messages-head))) + (aset pmail-message-vector + pmail-current-message (car messages-head)) + (setq pmail-deleted-vector + (concat pmail-deleted-vector deleted-head)) + (setq pmail-summary-vector + (vconcat pmail-summary-vector (make-vector total-messages nil))) + (setq pmail-msgref-vector + (vconcat pmail-msgref-vector (make-vector total-messages nil))) + ;; Fill in the new elements of pmail-msgref-vector. + (let ((i (1+ (- pmail-total-messages total-messages)))) + (while (<= i pmail-total-messages) + (aset pmail-msgref-vector i (list i)) + (setq i (1+ i)))) + (goto-char (point-min)) + (or nomsg (message "Counting new messages...done (%d)" total-messages)))) + +(defun pmail-set-message-counters () + (pmail-forget-messages) + (save-excursion + (save-restriction + (widen) + (let* ((point-save (point)) + (total-messages 0) + (messages-after-point) + (case-fold-search nil) + (messages-head nil) + (deleted-head nil)) + ;; Determine how many messages follow point. + (message "Counting messages...") + (goto-char (point-max)) + ;; Put at the end of messages-head + ;; the entry for message N+1, which marks + ;; the end of message N. (N = number of messages). + (setq messages-head (list (point-marker))) + (pmail-set-message-counters-counter (min (point) point-save)) + (setq messages-after-point total-messages) + + ;; Determine how many precede point. + (pmail-set-message-counters-counter) + (setq pmail-total-messages total-messages) + (setq pmail-current-message + (min total-messages + (max 1 (- total-messages messages-after-point)))) + (setq pmail-message-vector + (apply 'vector (cons (point-min-marker) messages-head)) + pmail-deleted-vector (concat "0" deleted-head) + pmail-summary-vector (make-vector pmail-total-messages nil) + pmail-msgref-vector (make-vector (1+ pmail-total-messages) nil)) + (let ((i 0)) + (while (<= i pmail-total-messages) + (aset pmail-msgref-vector i (list i)) + (setq i (1+ i)))) + (message "Counting messages...done"))))) + + +(defsubst pmail-collect-deleted (message-end) + "Collect the message deletion flags for each message. +MESSAGE-END is the buffer position corresponding to the end of +the message. Point is at the beginning of the message." + ;; NOTE: This piece of code will be executed on a per-message basis. + ;; In the face of thousands of messages, it has to be as fast as + ;; possible, hence some brute force constant use is employed in + ;; addition to inlining. + (save-excursion + (setq deleted-head + (cons (if (and (search-forward "X-BABYL-V6-ATTRIBUTES: " message-end t) + (looking-at "?D")) + ?D + ?\ ) deleted-head)))) + +(defun pmail-set-message-counters-counter (&optional stop) + ;; Collect the start position for each message into 'messages-head. + (let ((start (point))) + (while (search-backward "\n\nFrom " stop t) + (forward-char 2) + (pmail-collect-deleted start) + ;; Show progress after every 20 messages or so. + (setq messages-head (cons (point-marker) messages-head) + total-messages (1+ total-messages) + start (point)) + (if (zerop (% total-messages 20)) + (message "Counting messages...%d" total-messages))) + ;; Handle the first message, maybe. + (if stop + (goto-char stop) + (goto-char (point-min))) + (unless (not (looking-at "From ")) + (pmail-collect-deleted start) + (setq messages-head (cons (point-marker) messages-head) + total-messages (1+ total-messages))))) (defun pmail-beginning-of-message () "Show current message starting from the beginning." @@ -2098,38 +2764,58 @@ (defun pmail-unknown-mail-followup-to () "Handle a \"Mail-Followup-To\" header field with an unknown mailing list. Ask the user whether to add that list name to `mail-mailing-lists'." - (save-restriction - (let ((mail-followup-to (pmail-header-get-header "mail-followup-to" nil t))) - (when mail-followup-to - (let ((addresses - (split-string - (mail-strip-quoted-names mail-followup-to) - ",[[:space:]]+" t))) - (dolist (addr addresses) - (when (and (not (member addr mail-mailing-lists)) - (and pmail-user-mail-address-regexp - (not (string-match pmail-user-mail-address-regexp - addr))) - (y-or-n-p - (format "Add `%s' to `mail-mailing-lists'? " - addr))) - (customize-save-variable 'mail-mailing-lists - (cons addr mail-mailing-lists))))))))) + (save-restriction + (let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t))) + (when mail-followup-to + (let ((addresses + (split-string + (mail-strip-quoted-names mail-followup-to) + ",[[:space:]]+" t))) + (dolist (addr addresses) + (when (and (not (member addr mail-mailing-lists)) + (not + ;; taken from pmailsum.el + (string-match + (or pmail-user-mail-address-regexp + (concat "^\\(" + (regexp-quote (user-login-name)) + "\\($\\|@\\)\\|" + (regexp-quote + (or user-mail-address + (concat (user-login-name) "@" + (or mail-host-address + (system-name))))) + "\\>\\)")) + addr)) + (y-or-n-p + (format "Add `%s' to `mail-mailing-lists'? " + addr))) + (customize-save-variable 'mail-mailing-lists + (cons addr mail-mailing-lists))))))))) + +(defun pmail-swap-buffers-maybe () + "Determine if the Pmail buffer is showing a message. +If so restore the actual mbox message collection." + (unless (not pmail-buffers-swapped-p) + (with-current-buffer pmail-buffer + (buffer-swap-text pmail-view-buffer) + (setq pmail-buffers-swapped-p nil)))) (defun pmail-show-message (&optional n no-summary) "Show message number N (prefix argument), counting from start of file. -If NO-SUMMARY is non-nil, then do not update the summary buffer." +If summary buffer is currently displayed, update current message there also." (interactive "p") - (unless (eq major-mode 'pmail-mode) - (switch-to-buffer pmail-buffer)) - (if (zerop pmail-total-messages) - (progn - (message "No messages to show. Add something better soon.") - (force-mode-line-update)) - (let (blurb) - ;; Set n to the first sane message based on the sign of n: - ;; positive but greater than the total number of messages -> n; - ;; negative -> 1. + (or (eq major-mode 'pmail-mode) + (switch-to-buffer pmail-buffer)) + (pmail-swap-buffers-maybe) + (pmail-maybe-set-message-counters) + (widen) + (let (blurb) + (if (zerop pmail-total-messages) + (save-excursion + (with-current-buffer pmail-view-buffer + (erase-buffer) + (setq blurb "No mail."))) (if (not n) (setq n pmail-current-message) (cond ((<= n 0) @@ -2142,114 +2828,104 @@ blurb "No following message")) (t (setq pmail-current-message n)))) - (let ((beg (pmail-desc-get-start n)) - (end (pmail-desc-get-end n))) - (pmail-header-show-headers) - (widen) - (narrow-to-region beg end) - (goto-char (point-min)) - ;; Clear the "unseen" attribute when we show a message, unless - ;; it is already cleared. - (when (pmail-desc-attr-p pmail-desc-unseen-index n) - (pmail-desc-set-attribute n pmail-desc-unseen-index nil)) - (pmail-display-labels) - ;; Deal with MIME - (if (eq pmail-enable-mime t) - (funcall pmail-show-mime-function) - (setq pmail-view-buffer pmail-buffer)) - (when mail-mailing-lists - (pmail-unknown-mail-followup-to)) - (pmail-header-hide-headers) - (when transient-mark-mode (deactivate-mark)) - ;; Make sure that point in the Pmail window is at the beginning - ;; of the buffer. - (goto-char (point-min)) - (set-window-point (get-buffer-window pmail-buffer) (point)) - ;; Run any User code. - (run-hooks 'pmail-show-message-hook) - ;; If there is a summary buffer, try to move to this message in - ;; that buffer. But don't complain if this message is not - ;; mentioned in the summary. Don't do this at all if we were - ;; called on behalf of cursor motion in the summary buffer. - (when (and (pmail-summary-exists) (not no-summary)) - (let ((curr-msg pmail-current-message)) - ;; Set the summary current message, disabling the Pmail - ;; buffer update. - (with-current-buffer pmail-summary-buffer - (pmail-summary-goto-msg curr-msg nil t)))) - (with-current-buffer pmail-buffer - (pmail-auto-file)) - ;; Post back any status messages. - (when blurb - (message blurb)))))) - -(defun pmail-redecode-body (coding) - "Decode the body of the current message using coding system CODING. -This is useful with mail messages that have malformed or missing -charset= headers. - -This function assumes that the current message is already decoded -and displayed in the PMAIL buffer, but the coding system used to -decode it was incorrect. It then encodes the message back to its -original form, and decodes it again, using the coding system CODING. - -Note that if Emacs erroneously auto-detected one of the iso-2022 -encodings in the message, this function might fail because the escape -sequences that switch between character sets and also single-shift and -locking-shift codes are impossible to recover. This function is meant -to be used to fix messages encoded with 8-bit encodings, such as -iso-8859, koi8-r, etc." - (interactive "zCoding system for re-decoding this message: ") - (unless pmail-enable-mime + (let ((buf pmail-buffer) + (beg (pmail-msgbeg n)) + (end (pmail-msgend n)) + headers body) + (goto-char beg) + (setq headers (pmail-copy-headers beg end) + body (pmail-copy-body beg end)) + (pmail-set-attribute pmail-unseen-attr-index nil) + (with-current-buffer pmail-view-buffer + (erase-buffer) + (insert headers "\n") + (pmail-highlight-headers) + (insert body) + (goto-char (point-min))))) + (when mail-mailing-lists + (pmail-unknown-mail-followup-to)) + (if transient-mark-mode (deactivate-mark)) + (pmail-display-labels) + (buffer-swap-text pmail-view-buffer) + (setq pmail-buffers-swapped-p t) + (run-hooks 'pmail-show-message-hook) + ;; If there is a summary buffer, try to move to this message + ;; in that buffer. But don't complain if this message + ;; is not mentioned in the summary. + ;; Don't do this at all if we were called on behalf + ;; of cursor motion in the summary buffer. + (and (pmail-summary-exists) (not no-summary) + (let ((curr-msg pmail-current-message)) + (pmail-select-summary + (pmail-summary-goto-msg curr-msg t t)))) (with-current-buffer pmail-buffer + (pmail-auto-file)) + (if blurb + (message blurb)))) + +;; Find all occurrences of certain fields, and highlight them. +(defun pmail-highlight-headers () + ;; Do this only if the system supports faces. + (if (and (fboundp 'internal-find-face) + pmail-highlighted-headers) (save-excursion - (let ((start (pmail-desc-get-start pmail-current-message)) - (end (pmail-desc-get-end pmail-current-message)) - header) - (narrow-to-region start end) - (setq header (pmail-header-get-header "X-Coding-System")) - (if header - (let ((old-coding (intern header)) - (buffer-read-only nil)) - (check-coding-system old-coding) - ;; Make sure the new coding system uses the same EOL - ;; conversion, to prevent ^M characters from popping - ;; up all over the place. - (setq coding - (coding-system-change-eol-conversion - coding - (coding-system-eol-type old-coding))) - ;; Do the actual recoding. - (encode-coding-region start end old-coding) - (decode-coding-region start end coding) - ;; Rewrite the x-coding-system header according to - ;; what we did. - (setq last-coding-system-used coding) - (pmail-header-add-header - "X-Coding-System" - (symbol-name last-coding-system-used)) - (pmail-show-message pmail-current-message)) - (error "No X-Coding-System header found"))))))) - -;; FIXME: Double-check this + (search-forward "\n\n" nil 'move) + (save-restriction + (narrow-to-region (point-min) (point)) + (let ((case-fold-search t) + (inhibit-read-only t) + ;; Highlight with boldface if that is available. + ;; Otherwise use the `highlight' face. + (face (or 'pmail-highlight + (if (face-differs-from-default-p 'bold) + 'bold 'highlight))) + ;; List of overlays to reuse. + (overlays pmail-overlay-list)) + (goto-char (point-min)) + (while (re-search-forward pmail-highlighted-headers nil t) + (skip-chars-forward " \t") + (let ((beg (point)) + overlay) + (while (progn (forward-line 1) + (looking-at "[ \t]"))) + ;; Back up over newline, then trailing spaces or tabs + (forward-char -1) + (while (member (preceding-char) '(? ?\t)) + (forward-char -1)) + (if overlays + ;; Reuse an overlay we already have. + (progn + (setq overlay (car overlays) + overlays (cdr overlays)) + (overlay-put overlay 'face face) + (move-overlay overlay beg (point))) + ;; Make a new overlay and add it to + ;; pmail-overlay-list. + (setq overlay (make-overlay beg (point))) + (overlay-put overlay 'face face) + (setq pmail-overlay-list + (cons overlay pmail-overlay-list)))))))))) + (defun pmail-auto-file () "Automatically move a message into a sub-folder based on criteria. Called when a new message is displayed." - (if (or (member "filed" (pmail-desc-get-keywords pmail-current-message)) + (if (or (zerop pmail-total-messages) + (pmail-message-attr-p pmail-current-message "...F...") (not (string= (buffer-file-name) (expand-file-name pmail-file-name)))) - ;; Do nothing if it's already been filed. + ;; Do nothing if the message has already been filed or if there + ;; are no messages. nil ;; Find out some basics (common fields) (let ((from (mail-fetch-field "from")) (subj (mail-fetch-field "subject")) (to (concat (mail-fetch-field "to") "," (mail-fetch-field "cc"))) - (directives pmail-automatic-folder-directives) + (d pmail-automatic-folder-directives) (directive-loop nil) (folder nil)) - (while directives - (setq folder (car (car directives)) - directive-loop (cdr (car directives))) + (while d + (setq folder (car (car d)) + directive-loop (cdr (car d))) (while (and (car directive-loop) (let ((f (cond ((string= (car directive-loop) "from") from) @@ -2264,52 +2940,46 @@ (pmail-delete-forward) (if (string= "/dev/null" folder) (pmail-delete-message) - (pmail-output folder 1 t) - (setq directives nil)))) - (setq directives (cdr directives)))))) + (pmail-output-to-pmail-file folder 1 t) + (setq d nil)))) + (setq d (cdr d)))))) (defun pmail-next-message (n) "Show following message whether deleted or not. -With prefix arg N, moves forward N messages, or backward if N is -negative." +With prefix arg N, moves forward N messages, or backward if N is negative." (interactive "p") - (with-current-buffer pmail-buffer - (pmail-show-message (+ pmail-current-message n)))) + (set-buffer pmail-buffer) + (pmail-maybe-set-message-counters) + (pmail-show-message (+ pmail-current-message n))) (defun pmail-previous-message (n) "Show previous message whether deleted or not. -With prefix arg N, moves backward N messages, or forward if N is -negative." +With prefix arg N, moves backward N messages, or forward if N is negative." (interactive "p") (pmail-next-message (- n))) (defun pmail-next-undeleted-message (n) "Show following non-deleted message. -With prefix arg N, moves forward N non-deleted messages, or -backward if N is negative. +With prefix arg N, moves forward N non-deleted messages, +or backward if N is negative. Returns t if a new message is being shown, nil otherwise." (interactive "p") + (set-buffer pmail-buffer) + (pmail-maybe-set-message-counters) (let ((lastwin pmail-current-message) - (original pmail-current-message) (current pmail-current-message)) - ;; Move forwards, remember the last undeleted message seen. (while (and (> n 0) (< current pmail-total-messages)) (setq current (1+ current)) - (unless (pmail-desc-deleted-p current) - (setq lastwin current - n (1- n)))) - ;; Same thing for moving backwards + (if (not (pmail-message-deleted-p current)) + (setq lastwin current n (1- n)))) (while (and (< n 0) (> current 1)) (setq current (1- current)) - (unless (pmail-desc-deleted-p current) - (setq lastwin current - n (1+ n)))) - ;; Show the message (even if no movement took place so that the - ;; delete attribute is marked) and determine the result value. - (pmail-show-message lastwin) - (if (/= lastwin original) - t + (if (not (pmail-message-deleted-p current)) + (setq lastwin current n (1+ n)))) + (if (/= lastwin pmail-current-message) + (progn (pmail-show-message lastwin) + t) (if (< n 0) (message "No previous nondeleted message")) (if (> n 0) @@ -2326,44 +2996,70 @@ (defun pmail-first-message () "Show first message in file." (interactive) + (pmail-maybe-set-message-counters) (pmail-show-message 1)) (defun pmail-last-message () "Show last message in file." (interactive) + (pmail-maybe-set-message-counters) (pmail-show-message pmail-total-messages)) -(defun pmail-narrow-to-header (msg) - "Narrow the buffer to the headers of message number MSG." - (save-excursion - (let ((start (pmail-desc-get-start msg)) - (end (pmail-desc-get-end msg))) - (widen) - (goto-char start) - (unless (search-forward "\n\n" end t) - (error "Invalid message format")) - (narrow-to-region start (point))))) +(defun pmail-what-message () + (let ((where (point)) + (low 1) + (high pmail-total-messages) + (mid (/ pmail-total-messages 2))) + (while (> (- high low) 1) + (if (>= where (pmail-msgbeg mid)) + (setq low mid) + (setq high mid)) + (setq mid (+ low (/ (- high low) 2)))) + (if (>= where (pmail-msgbeg high)) high low))) (defun pmail-message-recipients-p (msg recipients &optional primary-only) (save-restriction + (goto-char (pmail-msgbeg msg)) + (search-forward "\n*** EOOH ***\n") + (narrow-to-region (point) (progn (search-forward "\n\n") (point))) (or (string-match recipients (or (mail-fetch-field "To") "")) (string-match recipients (or (mail-fetch-field "From") "")) (if (not primary-only) (string-match recipients (or (mail-fetch-field "Cc") "")))))) -(defun pmail-message-regexp-p (msg regexp) - "Return t, if for message number MSG, regexp REGEXP matches in the header." - (save-excursion - (save-restriction - (pmail-narrow-to-header msg) - (re-search-forward regexp nil t)))) +(defun pmail-message-regexp-p (n regexp) + "Return t, if for message number N, regexp REGEXP matches in the header." + (let ((beg (pmail-msgbeg n)) + (end (pmail-msgend n))) + (goto-char beg) + (forward-line 1) + (save-excursion + (save-restriction + (if (prog1 (= (following-char) ?0) + (forward-line 2) + ;; If there's a Summary-line in the (otherwise empty) + ;; header, we didn't yet get past the EOOH line. + (when (looking-at "^\\*\\*\\* EOOH \\*\\*\\*\n") + (forward-line 1)) + (setq beg (point)) + (narrow-to-region (point) end)) + (progn + (rfc822-goto-eoh) + (setq end (point))) + (setq beg (point)) + (search-forward "\n*** EOOH ***\n" end t) + (setq end (1+ (match-beginning 0))))) + (goto-char beg) + (if pmail-enable-mime + (funcall pmail-search-mime-header-function n regexp end) + (re-search-forward regexp end t))))) (defun pmail-search-message (msg regexp) "Return non-nil, if for message number MSG, regexp REGEXP matches." - (goto-char (pmail-desc-get-start msg)) + (goto-char (pmail-msgbeg msg)) (if pmail-enable-mime (funcall pmail-search-mime-message-function msg regexp) - (re-search-forward regexp (pmail-desc-get-end msg) t))) + (re-search-forward regexp (pmail-msgend msg) t))) (defvar pmail-search-last-regexp nil) (defun pmail-search (regexp &optional n) @@ -2394,12 +3090,13 @@ (if (< n 0) "Reverse " "") regexp) (set-buffer pmail-buffer) + (pmail-maybe-set-message-counters) (let ((omin (point-min)) (omax (point-max)) (opoint (point)) + win (reversep (< n 0)) - (msg pmail-current-message) - win) + (msg pmail-current-message)) (unwind-protect (progn (widen) @@ -2462,17 +3159,20 @@ (prefix-numeric-value current-prefix-arg)))) (pmail-search regexp (- (or n 1)))) -;; Show the first message which has the `unseen' attribute. + (defun pmail-first-unseen-message () - "Return the first message which has not been seen. If all messages -have been seen, then return the last message." + "Return the message index for the first message which has the +`unseen' attribute." + (pmail-maybe-set-message-counters) (let ((current 1) found) - (while (and (not found) (<= current pmail-total-messages)) - (if (pmail-desc-attr-p pmail-desc-unseen-index current) - (setq found current)) - (setq current (1+ current))) - (or found pmail-total-messages))) + (save-restriction + (widen) + (while (and (not found) (<= current pmail-total-messages)) + (if (pmail-message-attr-p current "......U") + (setq found current)) + (setq current (1+ current)))) + found)) (defun pmail-current-subject () "Return the current subject. @@ -2525,26 +3225,25 @@ (save-excursion (save-restriction (widen) - (if forward - (while (and (/= n 0) (< i pmail-total-messages)) - (let (done) - (while (and (not done) - (< i pmail-total-messages)) - (setq i (+ i 1)) - (pmail-narrow-to-header i) - (goto-char (point-min)) - (setq done (re-search-forward search-regexp (point-max) t))) - (if done (setq found i))) - (setq n (1- n))) - (while (and (/= n 0) (> i 1)) - (let (done) - (while (and (not done) (> i 1)) - (setq i (- i 1)) - (pmail-narrow-to-header i) - (goto-char (point-min)) - (setq done (re-search-forward search-regexp (point-max) t))) - (if done (setq found i))) - (setq n (1+ n)))))) + (while (and (/= n 0) + (if forward + (< i pmail-total-messages) + (> i 1))) + (let (done) + (while (and (not done) + (if forward + (< i pmail-total-messages) + (> i 1))) + (setq i (if forward (1+ i) (1- i))) + (goto-char (pmail-msgbeg i)) + (search-forward "\n*** EOOH ***\n") + (let ((beg (point)) end) + (search-forward "\n\n") + (setq end (point)) + (goto-char beg) + (setq done (re-search-forward search-regexp end t)))) + (if done (setq found i))) + (setq n (if forward (1- n) (1+ n)))))) (if found (pmail-show-message found) (error "No %s message with same subject" @@ -2559,12 +3258,17 @@ ;;;; *** Pmail Message Deletion Commands *** +(defun pmail-message-deleted-p (n) + (= (aref pmail-deleted-vector n) ?D)) + +(defun pmail-set-message-deleted-p (n state) + (aset pmail-deleted-vector n (if state ?D ?\ ))) + (defun pmail-delete-message () "Delete this message and stay on it." (interactive) - (pmail-desc-set-attribute pmail-current-message pmail-desc-deleted-index t) - (run-hooks 'pmail-delete-message-hook) - (pmail-show-message pmail-current-message)) + (pmail-set-attribute pmail-deleted-attr-index t) + (run-hooks 'pmail-delete-message-hook)) (defun pmail-undelete-previous-message () "Back up to deleted message, select it, and undelete it." @@ -2572,19 +3276,19 @@ (set-buffer pmail-buffer) (let ((msg pmail-current-message)) (while (and (> msg 0) - (not (pmail-desc-attr-p pmail-desc-deleted-index msg))) + (not (pmail-message-deleted-p msg))) (setq msg (1- msg))) (if (= msg 0) (error "No previous deleted message") - (pmail-desc-set-attribute msg pmail-desc-deleted-index nil) - (pmail-show-message msg) + (if (/= msg pmail-current-message) + (pmail-show-message msg)) + (pmail-set-attribute pmail-deleted-attr-index nil) (if (pmail-summary-exists) (save-excursion (set-buffer pmail-summary-buffer) (pmail-summary-mark-undeleted msg))) (pmail-maybe-display-summary)))) -;;; mbox: ready (defun pmail-delete-forward (&optional backward) "Delete this message and move to next nondeleted one. Deleted messages stay in the file until the \\[pmail-expunge] command is given. @@ -2592,7 +3296,7 @@ Returns t if a new message is displayed after the delete, or nil otherwise." (interactive "P") - (pmail-desc-set-attribute pmail-current-message pmail-desc-deleted-index t) + (pmail-set-attribute pmail-deleted-attr-index t) (run-hooks 'pmail-delete-message-hook) (let ((del-msg pmail-current-message)) (if (pmail-summary-exists) @@ -2601,39 +3305,46 @@ (prog1 (pmail-next-undeleted-message (if backward -1 1)) (pmail-maybe-display-summary)))) -;;; mbox: ready (defun pmail-delete-backward () "Delete this message and move to previous nondeleted one. Deleted messages stay in the file until the \\[pmail-expunge] command is given." (interactive) (pmail-delete-forward t)) +;; Compute the message number a given message would have after expunging. +;; The present number of the message is OLDNUM. +;; DELETEDVEC should be pmail-deleted-vector. +;; The value is nil for a message that would be deleted. +(defun pmail-msg-number-after-expunge (deletedvec oldnum) + (if (or (null oldnum) (= (aref deletedvec oldnum) ?D)) + nil + (let ((i 0) + (newnum 0)) + (while (< i oldnum) + (if (/= (aref deletedvec i) ?D) + (setq newnum (1+ newnum))) + (setq i (1+ i))) + newnum))) + (defun pmail-expunge-confirmed () - "Return t if deleted message should be expunged. If necessary, ask the user. + "Return t if deleted message should be expunged. If necessary, ask the user. See also user-option `pmail-confirm-expunge'." (set-buffer pmail-buffer) - (let ((some-deleted)) - (dotimes (i pmail-total-messages) - (if (pmail-desc-deleted-p (1+ i)) - (setq some-deleted t))) - (or (not some-deleted) - (null pmail-confirm-expunge) - (funcall pmail-confirm-expunge - "Erase deleted messages from Pmail file? ")))) + (or (not (stringp pmail-deleted-vector)) + (not (string-match "D" pmail-deleted-vector)) + (null pmail-confirm-expunge) + (funcall pmail-confirm-expunge + "Erase deleted messages from Pmail file? "))) (defun pmail-only-expunge (&optional dont-show) "Actually erase all deleted messages in the file." (interactive) + (set-buffer pmail-buffer) (message "Expunging deleted messages...") ;; Discard all undo records for this buffer. - (or (eq buffer-undo-list t) (setq buffer-undo-list nil)) - ;; Remove the messages from the buffer and from the Pmail message - ;; descriptor vector. - (setq pmail-expunge-counter 0) - (pmail-desc-prune-deleted-messages 'pmail-expunge-callback) - (setq pmail-current-message (- pmail-current-message pmail-expunge-counter)) - ;; Deal with the summary buffer and update - ;; the User status. + (or (eq buffer-undo-list t) + (setq buffer-undo-list nil)) + (pmail-maybe-set-message-counters) (let* ((omax (- (buffer-size) (point-max))) (omin (- (buffer-size) (point-min))) (opoint (if (and (> pmail-current-message 0) @@ -2642,39 +3353,86 @@ (if pmail-enable-mime (with-current-buffer pmail-view-buffer (- (point)(point-min))) - (- (point) (point-min)))))) - (when pmail-summary-buffer - (with-current-buffer pmail-summary-buffer - (pmail-update-summary))) - (message "Expunging deleted messages...done") - (if (not dont-show) - (pmail-show-message - (if (zerop pmail-current-message) 1 nil))) - (if pmail-enable-mime - (goto-char (+ (point-min) opoint)) - (goto-char (+ (point) opoint))))) - -;;; mbox: ready -(defun pmail-expunge-callback (n) - "Called after message N has been pruned to update the current Pmail - message counter." - ;; Process the various possible states to set the current message - ;; counter. - (setq pmail-total-messages (1- pmail-total-messages)) - (if (>= pmail-current-message n) - (setq pmail-expunge-counter (1+ pmail-expunge-counter)))) - -;;; mbox: ready + (- (point) (point-min))))) + (messages-head (cons (aref pmail-message-vector 0) nil)) + (messages-tail messages-head) + ;; Don't make any undo records for the expunging. + (buffer-undo-list t) + (win)) + (unwind-protect + (save-excursion + (widen) + (goto-char (point-min)) + (let ((counter 0) + (number 1) + (total pmail-total-messages) + (new-message-number pmail-current-message) + (new-summary nil) + (new-msgref (list (list 0))) + (pmailbuf (current-buffer)) + (buffer-read-only nil) + (messages pmail-message-vector) + (deleted pmail-deleted-vector) + (summary pmail-summary-vector)) + (setq pmail-total-messages nil + pmail-current-message nil + pmail-message-vector nil + pmail-deleted-vector nil + pmail-summary-vector nil) + + (while (<= number total) + (if (= (aref deleted number) ?D) + (progn + (delete-region + (marker-position (aref messages number)) + (marker-position (aref messages (1+ number)))) + (move-marker (aref messages number) nil) + (if (> new-message-number counter) + (setq new-message-number (1- new-message-number)))) + (setq counter (1+ counter)) + (setq messages-tail + (setcdr messages-tail + (cons (aref messages number) nil))) + (setq new-summary + (cons (if (= counter number) (aref summary (1- number))) + new-summary)) + (setq new-msgref + (cons (aref pmail-msgref-vector number) + new-msgref)) + (setcar (car new-msgref) counter)) + (if (zerop (% (setq number (1+ number)) 20)) + (message "Expunging deleted messages...%d" number))) + (setq messages-tail + (setcdr messages-tail + (cons (aref messages number) nil))) + (setq pmail-current-message new-message-number + pmail-total-messages counter + pmail-message-vector (apply 'vector messages-head) + pmail-deleted-vector (make-string (1+ counter) ?\ ) + pmail-summary-vector (vconcat (nreverse new-summary)) + pmail-msgref-vector (apply 'vector (nreverse new-msgref)) + win t))) + (message "Expunging deleted messages...done") + (if (not win) + (narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax))) + (if (not dont-show) + (pmail-show-message + (if (zerop pmail-current-message) 1 nil))) + (pmail-swap-buffers-maybe) + (if pmail-enable-mime + (goto-char (+ (point-min) opoint)) + (goto-char (+ (point) opoint)))))) + (defun pmail-expunge () "Erase deleted messages from Pmail file and summary buffer." (interactive) (when (pmail-expunge-confirmed) - (pmail-only-expunge))) + (pmail-only-expunge) + (if (pmail-summary-exists) + (pmail-select-summary (pmail-update-summary))))) ;;;; *** Pmail Mailing Commands *** -;;; mbox: In progress. I'm still not happy with the initial citation -;;; stuff. -pmr (defun pmail-start-mail (&optional noerase to subject in-reply-to cc replybuffer sendactions same-window others) (let (yank-action) @@ -2717,94 +3475,113 @@ prefix argument means ignore them. While composing the reply, use \\[mail-yank-original] to yank the original message into it." (interactive "P") - (if (= pmail-total-messages 0) - (error "No messages in this file")) - (save-excursion - (save-restriction - (let* ((msgnum pmail-current-message) - (from (pmail-header-get-header "from")) - (reply-to (or (pmail-header-get-header "reply-to" nil t) from)) - (cc (unless just-sender - (pmail-header-get-header "cc" nil t))) - (subject (pmail-header-get-header "subject")) - (date (pmail-header-get-header "date")) - (to (or (pmail-header-get-header "to" nil t) "")) - (message-id (pmail-header-get-header "message-id")) - (references (pmail-header-get-header "references" nil nil t)) - (resent-to (pmail-header-get-header "resent-reply-to" nil t)) - (resent-cc (unless just-sender - (pmail-header-get-header "resent-cc" nil t))) - (resent-reply-to (or (pmail-header-get-header "resent-to" nil t) ""))) - ;; Merge the resent-to and resent-cc into the to and cc. - (if (and resent-to (not (equal resent-to ""))) - (if (not (equal to "")) - (setq to (concat to ", " resent-to)) - (setq to resent-to))) - (if (and resent-cc (not (equal resent-cc ""))) - (if (not (equal cc "")) - (setq cc (concat cc ", " resent-cc)) - (setq cc resent-cc))) - ;; Add `Re: ' to subject if not there already. - (and (stringp subject) - (setq subject - (concat pmail-reply-prefix - (if (let ((case-fold-search t)) - (string-match pmail-reply-regexp subject)) - (substring subject (match-end 0)) - subject)))) - ;; Now setup the mail reply buffer. - (pmail-start-mail - nil - ;; Using mail-strip-quoted-names is undesirable with newer - ;; mailers since they can handle the names unstripped. I - ;; don't know whether there are other mailers that still need - ;; the names to be stripped. + (let (from reply-to cc subject date to message-id references + resent-to resent-cc resent-reply-to + (msgnum pmail-current-message)) + (save-excursion + (save-restriction + (if pmail-enable-mime + (narrow-to-region + (goto-char (point-min)) + (if (search-forward "\n\n" nil 'move) + (1+ (match-beginning 0)) + (point))) + (widen) + (goto-char (pmail-msgbeg pmail-current-message)) + (forward-line 1) + (if (= (following-char) ?0) + (narrow-to-region + (progn (forward-line 2) + (point)) + (progn (search-forward "\n\n" (pmail-msgend pmail-current-message) + 'move) + (point))) + (narrow-to-region (point) + (progn (search-forward "\n*** EOOH ***\n") + (beginning-of-line) (point))))) + (setq from (mail-fetch-field "from") + reply-to (or (mail-fetch-field "mail-reply-to" nil t) + (mail-fetch-field "reply-to" nil t) + from) + subject (mail-fetch-field "subject") + date (mail-fetch-field "date") + message-id (mail-fetch-field "message-id") + references (mail-fetch-field "references" nil nil t) + resent-reply-to (mail-fetch-field "resent-reply-to" nil t) + resent-cc (and (not just-sender) + (mail-fetch-field "resent-cc" nil t)) + resent-to (or (mail-fetch-field "resent-to" nil t) "") +;;; resent-subject (mail-fetch-field "resent-subject") +;;; resent-date (mail-fetch-field "resent-date") +;;; resent-message-id (mail-fetch-field "resent-message-id") + ) + (unless just-sender + (if (mail-fetch-field "mail-followup-to" nil t) + ;; If this header field is present, use it instead of the To and CC fields. + (setq to (mail-fetch-field "mail-followup-to" nil t)) + (setq cc (or (mail-fetch-field "cc" nil t) "") + to (or (mail-fetch-field "to" nil t) "")))) + + )) + + ;; Merge the resent-to and resent-cc into the to and cc. + (if (and resent-to (not (equal resent-to ""))) + (if (not (equal to "")) + (setq to (concat to ", " resent-to)) + (setq to resent-to))) + (if (and resent-cc (not (equal resent-cc ""))) + (if (not (equal cc "")) + (setq cc (concat cc ", " resent-cc)) + (setq cc resent-cc))) + ;; Add `Re: ' to subject if not there already. + (and (stringp subject) + (setq subject + (concat pmail-reply-prefix + (if (let ((case-fold-search t)) + (string-match pmail-reply-regexp subject)) + (substring subject (match-end 0)) + subject)))) + (pmail-start-mail + nil + ;; Using mail-strip-quoted-names is undesirable with newer mailers + ;; since they can handle the names unstripped. + ;; I don't know whether there are other mailers that still + ;; need the names to be stripped. ;;; (mail-strip-quoted-names reply-to) - ;; Remove unwanted names from reply-to, since Mail-Followup-To - ;; header causes all the names in it to wind up in reply-to, not - ;; in cc. But if what's left is an empty list, use the original. - (let* ((reply-to-list (rmail-dont-reply-to reply-to))) - (if (string= reply-to-list "") reply-to reply-to-list)) - subject - (pmail-make-in-reply-to-field from date message-id) - (if just-sender - nil - ;; mail-strip-quoted-names is NOT necessary for - ;; rmail-dont-reply-to to do its job. - (let* ((cc-list (rmail-dont-reply-to - (mail-strip-quoted-names - (if (null cc) to (concat to ", " cc)))))) - (if (string= cc-list "") nil cc-list))) - pmail-view-buffer - (list (list 'pmail-reply-callback pmail-buffer "answered" t msgnum)) - nil - (list (cons "References" (concat (mapconcat 'identity references " ") - " " message-id)))))))) - -(defun pmail-reply-callback (buffer attr state n) - "Mail reply callback function. -Sets ATTR (a string) if STATE is -non-nil, otherwise clears it. N is the message number. -BUFFER, possibly narrowed, contains an mbox mail message." + ;; Remove unwanted names from reply-to, since Mail-Followup-To + ;; header causes all the names in it to wind up in reply-to, not + ;; in cc. But if what's left is an empty list, use the original. + (let* ((reply-to-list (pmail-dont-reply-to reply-to))) + (if (string= reply-to-list "") reply-to reply-to-list)) + subject + (pmail-make-in-reply-to-field from date message-id) + (if just-sender + nil + ;; mail-strip-quoted-names is NOT necessary for pmail-dont-reply-to + ;; to do its job. + (let* ((cc-list (pmail-dont-reply-to + (mail-strip-quoted-names + (if (null cc) to (concat to ", " cc)))))) + (if (string= cc-list "") nil cc-list))) + pmail-view-buffer + (list (list 'pmail-mark-message + pmail-buffer + (with-current-buffer pmail-buffer + (aref pmail-msgref-vector msgnum)) + "answered")) + nil + (list (cons "References" (concat (mapconcat 'identity references " ") + " " message-id)))))) + +(defun pmail-mark-message (buffer msgnum-list attribute) + "Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE. +This is use in the send-actions for message buffers. +MSGNUM-LIST is a list of the form (MSGNUM) +which is an element of pmail-msgref-vector." (save-excursion (set-buffer buffer) - (pmail-set-attribute attr state n) - (pmail-show-message))) - -(defun pmail-mark-message (msgnum-list attr-index) - "Set attribute ATTRIBUTE-INDEX in the message of the car of MSGNUM-LIST. -This is used in the send-actions for -message buffers. MSGNUM-LIST is a list of the form (MSGNUM)." - (save-excursion - (let ((n (car msgnum-list))) - (set-buffer pmail-buffer) - (pmail-narrow-to-message n) - (pmail-desc-set-attribute n attr-index t)))) - -(defun pmail-narrow-to-message (n) - "Narrow the current (pmail) buffer to bracket message N." - (widen) - (narrow-to-region (pmail-desc-get-start n) (pmail-desc-get-end n))) + (if (car msgnum-list) + (pmail-set-attribute attribute t (car msgnum-list))))) (defun pmail-make-in-reply-to-field (from date message-id) (cond ((not from) @@ -2865,14 +3642,11 @@ (let ((mail-use-rfc822 t)) (pmail-make-in-reply-to-field from date message-id))))) -;;; mbox: ready (defun pmail-forward (resend) "Forward the current message to another user. With prefix argument, \"resend\" the message instead of forwarding it; see the documentation of `pmail-resend'." (interactive "P") - (if (= pmail-total-messages 0) - (error "No messages in this file")) (if resend (call-interactively 'pmail-resend) (let ((forward-buffer pmail-buffer) @@ -2890,7 +3664,7 @@ (list (list 'pmail-mark-message forward-buffer (with-current-buffer pmail-buffer - (pmail-desc-get-start msgnum)) + (aref pmail-msgref-vector msgnum)) "forwarded")) ;; If only one window, use it for the mail buffer. ;; Otherwise, use another window for the mail buffer @@ -2935,8 +3709,6 @@ Optional ALIAS-FILE is alternate aliases file to be used by sendmail, typically for purposes of moderating a list." (interactive "sResend to: ") - (if (= pmail-total-messages 0) - (error "No messages in this file")) (require 'sendmail) (require 'mailalias) (unless (or (eq pmail-view-buffer (current-buffer)) @@ -3017,7 +3789,7 @@ (funcall send-mail-function))) (kill-buffer tembuf)) (with-current-buffer pmail-buffer - (pmail-set-attribute "resent" t pmail-current-message)))) + (pmail-set-attribute pmail-resent-attr-index t pmail-current-message)))) (defvar mail-unsent-separator (concat "^ *---+ +Unsent message follows +---+ *$\\|" @@ -3047,16 +3819,16 @@ The variable `pmail-retry-ignored-headers' is a regular expression specifying headers which should not be copied into the new message." (interactive) - (if (= pmail-total-messages 0) - (error "No messages in this file")) (require 'mail-utils) (let ((pmail-this-buffer (current-buffer)) (msgnum pmail-current-message) bounce-start bounce-end bounce-indent resending + ;; Fetch any content-type header in current message + ;; Must search thru the whole unpruned header. (content-type (save-excursion (save-restriction - (pmail-header-get-header "Content-Type"))))) + (mail-fetch-field "Content-Type") )))) (save-excursion (goto-char (point-min)) (let ((case-fold-search t)) @@ -3120,8 +3892,7 @@ (if (pmail-start-mail nil nil nil nil nil pmail-this-buffer (list (list 'pmail-mark-message pmail-this-buffer - (with-current-buffer pmail-buffer - (pmail-desc-get-start msgnum)) + (aref pmail-msgref-vector msgnum) "retried"))) ;; Insert original text as initial text of new draft message. ;; Bind inhibit-read-only since the header delimiter @@ -3219,18 +3990,17 @@ (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))) (defun pmail-fontify-message () - "Fontify the current message if it is not already fontified." - (when (text-property-any (point-min) (point-max) 'pmail-fontified nil) - (let ((modified (buffer-modified-p)) - (buffer-undo-list t) (inhibit-read-only t) - before-change-functions after-change-functions - buffer-file-name buffer-file-truename) - (save-excursion - (save-match-data - (add-text-properties (point-min) (point-max) '(pmail-fontified t)) - (font-lock-fontify-region (point-min) (point-max)) - (and (not modified) (buffer-modified-p) - (set-buffer-modified-p nil))))))) + ;; Fontify the current message if it is not already fontified. + (if (text-property-any (point-min) (point-max) 'pmail-fontified nil) + (let ((modified (buffer-modified-p)) + (buffer-undo-list t) (inhibit-read-only t) + before-change-functions after-change-functions + buffer-file-name buffer-file-truename) + (save-excursion + (save-match-data + (add-text-properties (point-min) (point-max) '(pmail-fontified t)) + (font-lock-fontify-region (point-min) (point-max)) + (and (not modified) (buffer-modified-p) (set-buffer-modified-p nil))))))) ;;; Speedbar support for PMAIL files. (eval-when-compile (require 'speedbar)) @@ -3408,6 +4178,7 @@ (add-to-list 'desktop-buffer-mode-handlers '(pmail-mode . pmail-restore-desktop-buffer)) + (provide 'pmail) ;; Local Variables: