;; 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
;; 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 'mail-utils)
+(eval-when-compile (require 'mule-util)) ; for detect-coding-with-priority
-(require 'pmaildesc)
-(require 'pmailhdr)
-(require 'pmailkwd)
-(require 'mail-parse)
+(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\
(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
(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.
"\\|^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,
;;;###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)
:group 'pmail-headers
: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."
:group 'pmail-retrieve
: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.
(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.
(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)
(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.")
"*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
\f
;;; 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\\)?"
"\\|"
"\\) *")))
(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.
(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]*"
(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.
pmail-mime-feature))
(setq pmail-enable-mime nil)))))
+
;;;###autoload
(defun pmail (&optional file-name-arg)
"Read and edit incoming mail.
(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-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.
+ (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)
- ;; Initialize the Pmail state.
- (pmail-initialize-messages))
- ;; Now we're back in business. The happens even if we had a
- ;; perfectly fine file.
+ (pmail-mode-2)
+ (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)
+ )
+\f
+(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
(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
(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))
(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)
;; 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)))))
+ (pmail-select-summary (set-buffer-modified-p nil))))
-;;; mbox: ready
(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))
(quit-window)
(replace-buffer-in-windows obuf))))
-;;; mbox: ready
(defun pmail-bury ()
"Bury current Pmail buffer and its summary buffer."
(interactive)
(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
(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")))
(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)
(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))
\f
;;;; *** 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))
(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)
(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)
(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))))
(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)
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)
(message "")
(setq files (cdr files)))
delete-files))
-\f
-;;;; *** 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)))))))
\f
;;;; *** 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)
\f
;;;; *** 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
(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))))))
\f
;;;; *** Pmail Message Selection And Support ***
-(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 (1+ n))))
+
+(defun pmail-msgbeg (n)
+ (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.
(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."
(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)
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)
(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)
(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)
(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)
(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.
(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"
\f
;;;; *** 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."
(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.
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)
(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)
(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)))))
\f
;;;; *** 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)
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)
(let ((mail-use-rfc822 t))
(pmail-make-in-reply-to-field from date message-id)))))
\f
-;;; 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)
(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
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))
(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))))
\f
(defvar mail-unsent-separator
(concat "^ *---+ +Unsent message follows +---+ *$\\|"
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))
(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
(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)))))))
\f
;;; Speedbar support for PMAIL files.
(eval-when-compile (require 'speedbar))
(add-to-list 'desktop-buffer-mode-handlers
'(pmail-mode . pmail-restore-desktop-buffer))
+
(provide 'pmail)
;; Local Variables:
projects / emacs.git / commitdiff