;;; rmail.el --- main code of "RMAIL" mail reader for Emacs
;; Copyright (C) 1985, 1986, 1987, 1988, 1993, 1994, 1995, 1996, 1997, 1998,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
;; Free Software Foundation, Inc.
;; Maintainer: FSF
(defvar mail-abbrev-syntax-table)
(defvar mail-abbrevs)
(defvar messages-head)
-(defvar rmail-use-spam-filter)
-(defvar rsf-beep)
-(defvar rsf-sleep-after-message)
(defvar total-messages)
(defvar tool-bar-map)
:prefix "rmail-edit-"
:group 'rmail)
-(defgroup rmail-obsolete nil
- "Rmail obsolete customization variables."
- :group 'rmail)
-
(defcustom rmail-movemail-program nil
"If non-nil, the file name of the `movemail' program."
:group 'rmail-retrieve
:type '(choice (const nil) string))
-(defcustom rmail-pop-password nil
- "Password to use when reading mail from POP server.
-Please use `rmail-remote-password' instead."
- :type '(choice (string :tag "Password")
- (const :tag "Not Required" nil))
- :group 'rmail-obsolete)
-
-(defcustom rmail-pop-password-required nil
- "Non-nil if a password is required when reading mail from a POP server.
-Please use rmail-remote-password-required instead."
- :type 'boolean
- :group 'rmail-obsolete)
+(define-obsolete-variable-alias 'rmail-pop-password
+ 'rmail-remote-password "22.1")
(defcustom rmail-remote-password nil
"Password to use when reading mail from a remote server.
This setting is ignored for mailboxes whose URL already contains a password."
:type '(choice (string :tag "Password")
(const :tag "Not Required" nil))
- :set-after '(rmail-pop-password)
- :set #'(lambda (symbol value)
- (set-default symbol
- (if (and (not value)
- (boundp 'rmail-pop-password)
- rmail-pop-password)
- rmail-pop-password
- value))
- (setq rmail-pop-password nil))
:group 'rmail-retrieve
:version "22.1")
+(define-obsolete-variable-alias 'rmail-pop-password-required
+ 'rmail-remote-password-required "22.1")
+
(defcustom rmail-remote-password-required nil
"Non-nil if a password is required when reading mail from a remote server."
:type 'boolean
- :set-after '(rmail-pop-password-required)
- :set #'(lambda (symbol value)
- (set-default symbol
- (if (and (not value)
- (boundp 'rmail-pop-password-required)
- rmail-pop-password-required)
- rmail-pop-password-required
- value))
- (setq rmail-pop-password-required nil))
:group 'rmail-retrieve
:version "22.1")
;; If so, this can be moved there.
(rmail-movemail-variant-p)
+;;;###autoload
+(defcustom rmail-user-mail-address-regexp nil
+ "Regexp matching user mail addresses.
+If non-nil, this variable is used to identify the correspondent
+when receiving new mail. If it matches the address of the sender,
+the recipient is taken as correspondent of a mail.
+If nil \(default value\), your `user-login-name' and `user-mail-address'
+are used to exclude yourself as correspondent.
+
+Usually you don't have to set this variable, except if you collect mails
+sent by you under different user names.
+Then it should be a regexp matching your mail addresses.
+
+Setting this variable has an effect only before reading a mail."
+ :type '(choice (const :tag "None" nil) regexp)
+ :group 'rmail-retrieve
+ :version "21.1")
+
;;;###autoload
(defcustom rmail-dont-reply-to-names nil
"A regexp specifying addresses to prune from a reply message.
-A value of nil means exclude your own email address as an address
-plus whatever is specified by `rmail-default-dont-reply-to-names'."
+If this is nil, it is set the first time you compose a reply, to
+a value which excludes your own email address, plus whatever is
+specified by `rmail-default-dont-reply-to-names'.
+
+Matching addresses are excluded from the CC field in replies, and
+also the To field, unless this would leave an empty To field."
:type '(choice regexp (const :tag "Your Name" nil))
:group 'rmail-reply)
;;;###autoload
-(defvar rmail-default-dont-reply-to-names "\\`info-"
- "A regular expression specifying part of the default value of the
-variable `rmail-dont-reply-to-names', for when the user does not set
-`rmail-dont-reply-to-names' explicitly. (The other part of the default
-value is the user's email address and name.)
-It is useful to set this variable in the site customization file.")
+(defvar rmail-default-dont-reply-to-names (purecopy "\\`info-")
+ "Regexp specifying part of the default value of `rmail-dont-reply-to-names'.
+This is used when the user does not set `rmail-dont-reply-to-names'
+explicitly. (The other part of the default value is the user's
+email address and name.) It is useful to set this variable in
+the site customization file. The default value is conventionally
+used for large mailing lists to broadcast announcements.")
+;; Is it really useful to set this site-wide?
;;;###autoload
(defcustom rmail-ignored-headers
+ (purecopy
(concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:"
"\\|^status:\\|^received:\\|^x400-originator:\\|^x400-recipients:"
"\\|^x400-received:\\|^x400-mts-identifier:\\|^x400-content-type:"
"\\|^mbox-line:\\|^cancel-lock:"
"\\|^DomainKey-Signature:\\|^dkim-signature:"
"\\|^resent-face:\\|^resent-x.*:\\|^resent-organization:\\|^resent-openpgp:"
- "\\|^x-.*:")
+ "\\|^x-.*:"))
"Regexp to match header fields that Rmail should normally hide.
\(See also `rmail-nonignored-headers', which overrides this regexp.)
This variable is used for reformatting the message header,
:group 'rmail-headers)
;;;###autoload
-(defcustom rmail-retry-ignored-headers "^x-authentication-warning:"
+(defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:")
"Headers that should be stripped when retrying a failed message."
:type '(choice regexp (const nil :tag "None"))
- :group 'rmail-headers)
+ :group 'rmail-headers
+ :version "23.2") ; added x-detected-operating-system, x-spam
;;;###autoload
-(defcustom rmail-highlighted-headers "^From:\\|^Subject:"
+(defcustom rmail-highlighted-headers (purecopy "^From:\\|^Subject:")
"Regexp to match Header fields that Rmail should normally highlight.
-A value of nil means don't highlight."
+A value of nil means don't highlight. Uses the face `rmail-highlight'."
:type 'regexp
:group 'rmail-headers)
(defface rmail-highlight
'((t (:inherit highlight)))
- "Face to use for highlighting the most important header fields."
+ "Face to use for highlighting the most important header fields.
+The variable `rmail-highlighted-headers' specifies which headers."
:group 'rmail-headers
:version "22.1")
(defface rmail-header-name
'((t (:inherit font-lock-function-name-face)))
- "Face to use for highlighting the header names."
+ "Face to use for highlighting the header names.
+The variable `rmail-font-lock-keywords' specifies which headers
+get highlighted."
:group 'rmail-headers
:version "23.1")
;;;###autoload
(defcustom rmail-primary-inbox-list nil
- "List of files which are inboxes for user's primary mail file `~/RMAIL'.
-nil means the default, which is (\"/usr/spool/mail/$USER\")
-\(the name varies depending on the operating system,
-and the value of the environment variable MAIL overrides it)."
- ;; Don't use backquote here, because we don't want to need it
- ;; at load time.
+ "List of files that are inboxes for your primary mail file `rmail-file-name'.
+If this is nil, uses the environment variable MAIL. If that is
+unset, uses a file named by the function `user-login-name' in the
+directory `rmail-spool-directory' (whose value depends on the
+operating system). For example, \"/var/mail/USER\"."
+ ;; Don't use backquote here, because we don't want to need it at load time.
+ ;; (That must be an old comment - it's dumped these days.)
:type (list 'choice '(const :tag "Default" nil)
(list 'repeat ':value (list (or (getenv "MAIL")
- (concat "/var/spool/mail/"
- (getenv "USER"))))
+ (concat rmail-spool-directory
+ (user-login-name))))
'file))
:group 'rmail-retrieve
:group 'rmail-files)
:group 'rmail-reply)
;;;###autoload
-(defcustom rmail-secondary-file-directory "~/"
+(defcustom rmail-secondary-file-directory (purecopy "~/")
"Directory for additional secondary Rmail files."
:type 'directory
:group 'rmail-files)
;;;###autoload
-(defcustom rmail-secondary-file-regexp "\\.xmail$"
+(defcustom rmail-secondary-file-regexp (purecopy "\\.xmail$")
"Regexp for which files are secondary Rmail files."
:type 'regexp
:group 'rmail-files)
(defcustom rmail-confirm-expunge 'y-or-n-p
- "Whether and how to ask for confirmation before expunging deleted messages."
+ "Whether and how to ask for confirmation before expunging deleted messages.
+The value, if non-nil is a function to call with a question (string)
+as argument, to ask the user that question."
:type '(choice (const :tag "No confirmation" nil)
(const :tag "Confirm with y-or-n-p" y-or-n-p)
(const :tag "Confirm with yes-or-no-p" yes-or-no-p))
:version "21.1"
:group 'rmail-files)
+(put 'rmail-confirm-expunge 'risky-local-variable t)
;;;###autoload
(defvar rmail-mode-hook nil
(defvar rmail-mmdf-delim2 "^\001\001\001\001\n"
"Regexp marking the end of an mmdf message.")
+;; FIXME Post-mbox, this is now unused.
+;; In Emacs-22, this was called:
+;; i) the very first time a message was shown.
+;; ii) when toggling the headers to the normal state, every time.
+;; It's not clear what it should do now, since there is nothing that
+;; records when a message is shown for the first time (unseen is not
+;; necessarily the same thing).
(defcustom rmail-message-filter nil
"If non-nil, a filter function for new messages in RMAIL.
Called with region narrowed to the message, including headers,
examples:
(\"/dev/null\" \"from\" \"@spam.com\") ; delete all mail from spam.com
- (\"RMS\" \"from\" \"rms@\") ; save all mail from RMS."
+ (\"RMS\" \"from\" \"rms@\") ; save all mail from RMS.
+
+Note that this is only applied in the folder specifed by `rmail-file-name'."
:group 'rmail
:version "21.1"
:type '(repeat (sexp :tag "Directive")))
In a summary buffer, this holds the RMAIL buffer it is a summary for.")
(put 'rmail-buffer 'permanent-local t)
+(defvar rmail-was-converted nil
+ "Non-nil in an Rmail buffer that was just converted from Babyl format.")
+(put 'rmail-was-converted 'permanent-local t)
+
+(defvar rmail-seriously-modified nil
+ "Non-nil in an Rmail buffer that has been modified in a major way.")
+(put 'rmail-seriously-modified 'permanent-local t)
+
;; Message counters and markers. Deleted flags.
-(defvar rmail-current-message nil)
+(defvar rmail-current-message nil
+ "Integer specifying the message currently being displayed in this folder.")
(put 'rmail-current-message 'permanent-local t)
-(defvar rmail-total-messages nil)
+(defvar rmail-total-messages nil
+ "Integer specifying the total number of messages in this folder.
+Includes deleted messages.")
(put 'rmail-total-messages 'permanent-local t)
-(defvar rmail-message-vector nil)
+(defvar rmail-message-vector nil
+ "Vector of markers specifying the start and end of each message.
+Element N and N+1 specify the start and end of message N.")
(put 'rmail-message-vector 'permanent-local t)
-(defvar rmail-deleted-vector nil)
+(defvar rmail-deleted-vector nil
+ "A string of length `rmail-total-messages' plus one.
+Character N is either a space or \"D\", according to whether
+message N is deleted or not.")
(put 'rmail-deleted-vector 'permanent-local t)
(defvar rmail-msgref-vector nil
(defvar rmail-summary-buffer nil)
(put 'rmail-summary-buffer 'permanent-local t)
-(defvar rmail-summary-vector nil)
+(defvar rmail-summary-vector nil
+ "In an Rmail buffer, vector of (newline-terminated) strings.
+Element N specifies the summary line for message N+1.")
(put 'rmail-summary-vector 'permanent-local t)
;; Rmail buffer swapping variables.
"\n"))
"Regexp matching the delimiter of messages in UNIX mail format
\(UNIX From lines), minus the initial ^. Note that if you change
-this expression, you must change the code in rmail-nuke-pinhead-header
+this expression, you must change the code in `rmail-nuke-pinhead-header'
that knows the exact ordering of the \\( \\) subexpressions.")
+;; FIXME the rmail-header-name headers ought to be customizable.
+;; It seems a bit arbitrary, for example, that all of the Date: line
+;; gets highlighted.
(defvar rmail-font-lock-keywords
;; These are all matched case-insensitively.
(eval-when-compile
(cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
(list '("^\\(From\\|Sender\\|Resent-From\\):"
. 'rmail-header-name)
- '("^Reply-To:.*$" . 'rmail-header-name)
+ '("^\\(Mail-\\)?Reply-To:.*$" . 'rmail-header-name)
+ ;; FIXME Mail-Followup-To should probably be here too.
'("^Subject:" . 'rmail-header-name)
'("^X-Spam-Status:" . 'rmail-header-name)
'("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"
. 'rmail-header-name))))
"Additional expressions to highlight in Rmail mode.")
+;; Rmail does not expect horizontal splitting. (Bug#2282)
+(defun rmail-pop-to-buffer (&rest args)
+ "Like `pop-to-buffer', but with `split-width-threshold' set to nil."
+ (let (split-width-threshold)
+ (apply 'pop-to-buffer args)))
+
;; Perform BODY in the summary buffer
;; in such a way that its cursor is properly updated in its own window.
(defmacro rmail-select-summary (&rest body)
(save-excursion
(unwind-protect
(progn
- (pop-to-buffer rmail-summary-buffer)
+ (rmail-pop-to-buffer rmail-summary-buffer)
;; rmail-total-messages is a buffer-local var
;; in the rmail buffer.
;; This way we make it available for the body
\f
;;;; *** Rmail Mode ***
-;; This variable is dynamically bound. The defvar is here to placate
-;; the byte compiler.
-
-(defvar rmail-enable-multibyte nil)
-
-
(defun rmail-require-mime-maybe ()
"Require `rmail-mime-feature' if that is non-nil.
Signal an error and set `rmail-mime-feature' to nil if the feature
(find-file file-name)
(when (and (verify-visited-file-modtime existed)
(eq major-mode 'rmail-mode))
+ (rmail-swap-buffers-maybe)
(rmail-set-message-counters)))
;; The mail file is either unchanged or not visited. Visit it.
(switch-to-buffer
- (let ((enable-local-variables nil))
+ (let ((enable-local-variables nil)
+ ;; Force no-conversion by default, since that's what
+ ;; pre-mbox Rmail did with BABYL files (via
+ ;; auto-coding-regexp-alist).
+ (coding-system-for-read
+ (or coding-system-for-read 'no-conversion)))
(find-file-noselect file-name))))
;; Ensure that the collection and view buffers are in sync and
;; ensure that a message is not being edited.
(unwind-protect
;; Only get new mail when there is not a file name argument.
(unless file-name-arg
- (rmail-get-new-mail))
+ (setq msg-shown (rmail-get-new-mail)))
(progn
(set-buffer mail-buf)
- (rmail-show-message-maybe (rmail-first-unseen-message))
+ (or msg-shown
+ (rmail-show-message (rmail-first-unseen-message)))
(if rmail-display-summary (rmail-summary))
(rmail-construct-io-menu)
(if run-mail-hook
(widen)
(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.
- (rmail-convert-babyl-to-mbox))
- ((looking-at "Version: 5\n")
- ;; Losing babyl file made by old version of Rmail. Fix the
- ;; babyl file header and use unrmail to convert to mbox
- ;; format.
- (let ((buffer-read-only nil))
- (insert "BABYL OPTIONS: -*- rmail -*-\n")
- (rmail-convert-babyl-to-mbox)))
- ((equal (point-min) (point-max))
- (message "Empty Rmail file."))
- ((looking-at "From "))
- (t (error "Invalid mbox file"))))
+ (let ((case-fold-search nil))
+ (cond ((looking-at "BABYL OPTIONS:")
+ ;; The file is Babyl version 5. Use unrmail to convert
+ ;; it.
+ (rmail-convert-babyl-to-mbox))
+ ((looking-at "Version: 5\n")
+ ;; Losing babyl file made by old version of Rmail. Fix the
+ ;; babyl file header and use unrmail to convert to mbox
+ ;; format.
+ (let ((buffer-read-only nil))
+ (insert "BABYL OPTIONS: -*- rmail -*-\n")
+ (rmail-convert-babyl-to-mbox)))
+ ((equal (point-min) (point-max))
+ (message "Empty Rmail file."))
+ ((looking-at "From "))
+ (t (error "Invalid mbox file")))))
(defun rmail-error-bad-format (&optional msgnum)
"Report that the buffer is not in the mbox file format.
(defun rmail-convert-babyl-to-mbox ()
"Convert the mail file from Babyl version 5 to mbox.
This function also reinitializes local variables used by Rmail."
- (unless (y-or-n-p "Babyl mail file detected. Rmail now uses mbox format for mail files.
-Convert Babyl mail file to mbox format? ")
- (error "Aborted"))
(let ((old-file (make-temp-file "rmail"))
(new-file (make-temp-file "rmail")))
(unwind-protect
(rmail-mode-1)
(rmail-perm-variables)
(rmail-variables)
+ (setq rmail-was-converted t)
+ (rmail-dont-modify-format)
(goto-char (point-max))
(rmail-set-message-counters))
(message "Replacing BABYL format with mbox format...done"))
(define-key map "d" 'rmail-delete-forward)
(define-key map "\C-d" 'rmail-delete-backward)
(define-key map "e" 'rmail-edit-current-message)
+ ;; If you change this, change the rmail-resend menu-item's :keys.
(define-key map "f" 'rmail-forward)
(define-key map "g" 'rmail-get-new-mail)
(define-key map "h" 'rmail-summary)
(define-key map "i" 'rmail-input)
- (define-key map "j" 'rmail-show-message-maybe)
+ (define-key map "j" 'rmail-show-message)
(define-key map "k" 'rmail-kill-label)
(define-key map "l" 'rmail-summary-by-labels)
(define-key map "\e\C-h" 'rmail-summary)
(define-key map "\es" 'rmail-search)
(define-key map "t" 'rmail-toggle-header)
(define-key map "u" 'rmail-undelete-previous-message)
+ (define-key map "v" 'rmail-mime)
(define-key map "w" 'rmail-output-body-to-file)
(define-key map "\C-c\C-w" 'rmail-widen)
(define-key map "x" 'rmail-expunge)
'("Continue" . rmail-continue))
(define-key map [menu-bar mail resend]
- '("Re-send..." . rmail-resend))
+ '(menu-item "Resend..." rmail-resend :keys "C-u f"))
(define-key map [menu-bar mail forward]
'("Forward" . rmail-forward))
(define-key map [menu-bar move next]
'("Next" . rmail-next-message))
- map))
+ map)
+ "Keymap used in Rmail mode.")
;; Rmail toolbar
(defvar rmail-tool-bar-map
(defun rmail-mode-kill-summary ()
(if rmail-summary-buffer (kill-buffer rmail-summary-buffer)))
+(defvar rmail-enable-multibyte) ; dynamically bound
+
;;;###autoload
(defun rmail-mode ()
"Rmail Mode is used by \\<rmail-mode-map>\\[rmail] for editing Rmail files.
\\[rmail-previous-message] Move to Previous message whether deleted or not.
\\[rmail-first-message] Move to the first message in Rmail file.
\\[rmail-last-message] Move to the last message in Rmail file.
-\\[rmail-show-message-maybe] Jump to message specified by numeric position in file.
+\\[rmail-show-message] Jump to message specified by numeric position in file.
\\[rmail-search] Search for string and show message it is found in.
\\[rmail-delete-forward] Delete this message, move to next nondeleted.
\\[rmail-delete-backward] Delete this message, move to previous nondeleted.
(rmail-mode-2)
(when (and finding-rmail-file
(null coding-system-for-read)
- default-enable-multibyte-characters)
+ (default-value 'enable-multibyte-characters))
(let ((rmail-enable-multibyte t))
(rmail-require-mime-maybe)
(rmail-convert-file-maybe)
(goto-char (point-max))
(set-buffer-multibyte t)))
(rmail-set-message-counters)
- (rmail-show-message-maybe rmail-total-messages)
+ (rmail-show-message rmail-total-messages)
(when finding-rmail-file
(when rmail-display-summary
(rmail-summary))
(defun rmail-generate-viewer-buffer ()
"Return a reusable buffer suitable for viewing messages.
Create the buffer if necessary."
- (let* ((suffix (file-name-nondirectory (or buffer-file-name (buffer-name))))
- (name (format " *message-viewer %s*" suffix))
- (buf (get-buffer name)))
- (or buf
- (generate-new-buffer name))))
+ ;; We want to reuse any existing view buffer, so as not to create an
+ ;; endless number of them. But we must avoid clashes if we visit
+ ;; two different rmail files with the same basename (Bug#4593).
+ (if (and (local-variable-p 'rmail-view-buffer)
+ (buffer-live-p rmail-view-buffer))
+ rmail-view-buffer
+ (generate-new-buffer
+ (format " *message-viewer %s*"
+ (file-name-nondirectory (or buffer-file-name (buffer-name)))))))
(defun rmail-swap-buffers ()
"Swap text between current buffer and `rmail-view-buffer'.
This function preserves the current buffer's modified flag, and also
sets the current buffer's `buffer-file-coding-system' to that of
`rmail-view-buffer'."
- (let ((modp (buffer-modified-p))
- (coding
+ (let ((modp-this (buffer-modified-p))
+ (modp-that
+ (with-current-buffer rmail-view-buffer (buffer-modified-p)))
+ (coding-this buffer-file-coding-system)
+ (coding-that
(with-current-buffer rmail-view-buffer
buffer-file-coding-system)))
(buffer-swap-text rmail-view-buffer)
- (setq buffer-file-coding-system coding)
- (restore-buffer-modified-p modp)))
+ (setq buffer-file-coding-system coding-that)
+ (with-current-buffer rmail-view-buffer
+ (setq buffer-file-coding-system coding-this)
+ (restore-buffer-modified-p modp-that))
+ (restore-buffer-modified-p modp-this)))
(defun rmail-buffers-swapped-p ()
"Return non-nil if the message collection is in `rmail-view-buffer'."
(rmail-swap-buffers)
(setq rmail-buffer-swapped nil))))
+(defun rmail-modify-format ()
+ "Warn if important modifications would change Rmail file's format."
+ (with-current-buffer rmail-buffer
+ (and rmail-was-converted
+ ;; If it's already modified, don't warn again.
+ (not rmail-seriously-modified)
+ (not
+ (yes-or-no-p
+ (message "After this, %s would be saved in mbox format. Proceed? "
+ (buffer-name))))
+ (error "Aborted"))
+ (setq rmail-seriously-modified t)))
+
+(defun rmail-dont-modify-format ()
+ (when (and rmail-was-converted (not rmail-seriously-modified))
+ (set-buffer-modified-p nil)
+ (message "Marking buffer unmodified to avoid rewriting Babyl file as mbox file")))
+
(defun rmail-mode-kill-buffer-hook ()
(if (buffer-live-p rmail-view-buffer) (kill-buffer rmail-view-buffer)))
(make-local-variable 'rmail-last-regexp)
(make-local-variable 'rmail-deleted-vector)
(make-local-variable 'rmail-buffer)
+ (make-local-variable 'rmail-was-converted)
+ (setq rmail-was-converted nil)
+ (make-local-variable 'rmail-seriously-modified)
+ (setq rmail-seriously-modified nil)
(setq rmail-buffer (current-buffer))
(set-buffer-multibyte nil)
(with-current-buffer (setq rmail-view-buffer (rmail-generate-viewer-buffer))
(setq buffer-undo-list t)
+ ;; Note that this does not erase the buffer. Should it?
+ ;; It depends on how this is called. If somehow called with the
+ ;; rmail buffers swapped, it would erase the message collection.
+ (set (make-local-variable 'rmail-overlay-list) nil)
(set-buffer-multibyte t)
;; Force C-x C-s write Unix EOLs.
(set-buffer-file-coding-system 'undecided-unix))
(make-local-variable 'rmail-current-message)
(make-local-variable 'rmail-total-messages)
(setq rmail-total-messages 0)
- (make-local-variable 'rmail-overlay-list)
- (setq rmail-overlay-list nil)
(make-local-variable 'rmail-message-vector)
(make-local-variable 'rmail-msgref-vector)
(make-local-variable 'rmail-inbox-list)
(setq rmail-inbox-list
(or rmail-primary-inbox-list
(list (or (getenv "MAIL")
+ ;; FIXME expand-file-name?
(concat rmail-spool-directory
(user-login-name)))))))
(set (make-local-variable 'tool-bar-map) rmail-tool-bar-map))
;; 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)
+ ;; Don't turn off auto-saving based on the size of the buffer
+ ;; because that code does not understand buffer-swapping.
+ (make-local-variable 'auto-save-include-big-deletions)
+ (setq auto-save-include-big-deletions t)
(make-local-variable 'revert-buffer-function)
(setq revert-buffer-function 'rmail-revert)
(make-local-variable 'font-lock-defaults)
(let* ((revert-buffer-function (default-value 'revert-buffer-function))
(rmail-enable-multibyte enable-multibyte-characters)
;; See similar code in `rmail'.
- (coding-system-for-read (and rmail-enable-multibyte 'raw-text)))
+ ;; FIXME needs updating?
+ (coding-system-for-read (and rmail-enable-multibyte 'raw-text))
+ (before-revert-hook 'rmail-swap-buffers-maybe))
;; 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,
(set-buffer-multibyte t))
(goto-char (point-max))
(rmail-set-message-counters)
- (rmail-show-message-maybe rmail-total-messages)
+ (rmail-show-message rmail-total-messages)
(run-hooks 'rmail-mode-hook))))
(defun rmail-expunge-and-save ()
"Expunge and save RMAIL file."
(interactive)
(set-buffer rmail-buffer)
- (rmail-expunge t)
+ (rmail-expunge)
;; No need to swap buffers: rmail-write-region-annotate takes care of it.
;; (rmail-swap-buffers-maybe)
(save-buffer)
(if (rmail-summary-exists)
- (rmail-select-summary (set-buffer-modified-p nil)))
- (rmail-show-message))
+ (rmail-select-summary (set-buffer-modified-p nil))))
(defun rmail-quit ()
"Quit out of RMAIL.
(interactive)
(set-buffer rmail-buffer)
(rmail-expunge t)
- (rmail-swap-buffers-maybe)
(save-buffer)
(when (boundp 'rmail-quit-hook)
(run-hooks 'rmail-quit-hook))
;; Don't switch to the summary buffer even if it was recently visible.
(when rmail-summary-buffer
+ (with-current-buffer rmail-summary-buffer
+ (set-buffer-modified-p nil))
(replace-buffer-in-windows rmail-summary-buffer)
(bury-buffer rmail-summary-buffer))
(if rmail-enable-mime
\f
(defun rmail-duplicate-message ()
"Create a duplicated copy of the current message.
-The duplicate copy goes into the Rmail file just after the
-original copy."
- (interactive)
+The duplicate copy goes into the Rmail file just after the original."
;; If we are in a summary buffer, switch to the Rmail buffer.
+ ;; FIXME simpler to swap the contents, not the buffers?
(set-buffer rmail-buffer)
+ (rmail-modify-format)
(let ((buff (current-buffer))
(n rmail-current-message)
(beg (rmail-msgbeg rmail-current-message))
(end (rmail-msgend rmail-current-message)))
(if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
- (widen)
- (let ((buffer-read-only nil)
+ (widen)
+ (let ((buffer-read-only nil)
(string (buffer-substring-no-properties beg end)))
(goto-char end)
(insert string))
(goto-char (point-max))
(rmail-set-message-counters)
(set-buffer-modified-p t)
- (rmail-show-message n))
+ (rmail-show-message-1 n))
(if (rmail-summary-exists)
(rmail-select-summary (rmail-update-summary)))
(message "Message duplicated"))
(sort files 'string<))))
(defun rmail-list-to-menu (menu-name l action &optional full-name)
- (let ((menu (make-sparse-keymap menu-name)))
+ (let ((menu (make-sparse-keymap menu-name))
+ name)
(mapc
(lambda (item)
(let (command)
\f
;;;; *** Rmail input ***
-(declare-function rmail-spam-filter "rmail-spam-filter" (msg))
(declare-function rmail-summary-goto-msg "rmailsum" (&optional n nowarn skip-rmail))
(declare-function rmail-summary-mark-undeleted "rmailsum" (n))
(declare-function rmail-summary-mark-deleted "rmailsum" (&optional n undel))
;; RLK feature not added in this version:
;; argument specifies inbox file or files in various ways.
+;; In Babyl, the Mail: header in the preamble overrode rmail-inbox-list.
+;; Mbox does not have this feature.
(defun rmail-get-new-mail (&optional file-name)
- "Move any new mail from this RMAIL file's inbox files.
-The inbox files can be specified with the file's Mail: option. The
-variable `rmail-primary-inbox-list' specifies the inboxes for your
-primary RMAIL 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.
+ "Move any new mail from this Rmail file's inbox files.
+The buffer-local variable `rmail-inbox-list' specifies the list
+of inbox files. By default, this is nil, except for your primary
+Rmail file `rmail-file-name'. In this case, when you first visit
+the Rmail file it is initialized using either
+`rmail-primary-inbox-list', or the \"MAIL\" environment variable,
+or the function `user-login-name' and the directory
+`rmail-spool-directory' (whose value depends on the operating system).
+
+The command `set-rmail-inbox-list' sets `rmail-inbox-list' to the
+value you specify.
+
+You can also specify the file to get new mail from just for one
+instance of this command. 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 `rmail-preserve-inbox' is non-nil, new mail will
always be left in inbox files rather than deleted.
-This function runs `rmail-get-new-mail-hook' before saving the updated file.
-It returns t if it got any new messages."
+Before doing anything, this runs `rmail-before-get-new-mail-hook'.
+Just before returning, it runs `rmail-after-get-new-mail-hook',
+whether or not there is new mail.
+
+If there is new mail, it runs `rmail-get-new-mail-hook', saves
+the updated file, and shows the first unseen message (which might
+not be a new one). It returns non-nil if it got any new messages."
(interactive
(list (if current-prefix-arg
(read-file-name "Get new mail from file: "))))
(or (verify-visited-file-modtime (current-buffer))
(find-file (buffer-file-name)))
(set-buffer rmail-buffer)
+ (rmail-modify-format)
(rmail-swap-buffers-maybe)
(rmail-maybe-set-message-counters)
(widen)
(let ((opoint (point))
;; 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)))
+ (make-backup-files (and make-backup-files
+ (buffer-modified-p)))
(buffer-read-only nil)
;; Don't make undo records while getting mail.
(buffer-undo-list t)
;; to be that rmail-insert-inbox-text uses .newmail-BASENAME.
(while (and all-files
(not (member (file-name-nondirectory (car all-files))
- file-last-names)))
+ 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))
+ ;; In case of brain damage caused by require-final-newline.
(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
+ (skip-chars-backward " \t\n")
+ (delete-region (point) (point-max))
(setq found (or
(rmail-get-new-mail-1 file-name files delete-files)
found))))
;; Move to the first new message unless we have other unseen
;; messages before it.
- (if found (rmail-show-message-maybe (rmail-first-unseen-message)))
+ (if found (rmail-show-message (rmail-first-unseen-message)))
(run-hooks 'rmail-after-get-new-mail-hook)
found)
;; Don't leave the buffer screwed up if we get a disk-full error.
- (rmail-show-message-maybe))))
+ (rmail-show-message))))
+
+(defvar rmail-use-spam-filter)
+(declare-function rmail-get-new-mail-filter-spam "rmail-spam-filter" (nnew))
(defun rmail-get-new-mail-1 (file-name files delete-files)
"Return t if new messages are detected without error, nil otherwise."
(if (zerop new-messages)
(when (or file-name rmail-inbox-list)
(message "(No new mail has arrived)"))
- ;; Generate the spam message.
- (setq blurb (if spam-filter-p
- (rmail-get-new-mail-filter-spam new-messages)
- "")))
+ (if spam-filter-p
+ (setq blurb (rmail-get-new-mail-filter-spam new-messages))))
(if (rmail-summary-exists)
(rmail-select-summary (rmail-update-summary)))
(setq suffix (if (= 1 new-messages) "" "s"))
(message "%d new message%s read%s" new-messages suffix blurb)
- (when spam-filter-p
- (if rsf-beep (beep t))
- (sleep-for rsf-sleep-after-message))
-
;; Establish the return value.
(setq result (> new-messages 0))
result))))
-(defun rmail-get-new-mail-filter-spam (new-message-count)
- "Process new messages for spam."
- (let* ((old-messages (- rmail-total-messages new-message-count))
- (rsf-number-of-spam 0)
- (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 rmail-deleted-vector 0 (1+ old-messages)))
- blurb)
- ;; set all messages to undeleted
- (setq rmail-deleted-vector (make-string (1+ rmail-total-messages) ?\ ))
- (while (<= rsf-scanned-message-number rmail-total-messages)
- (progn
- (if (not (rmail-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 (rmail-expunge-confirmed)
- (rmail-only-expunge t))))
- (setq rmail-deleted-vector
- (concat save-deleted
- (make-string (- rmail-total-messages old-messages) ?\ )))
- ;; Generate a return value message based on the number of spam
- ;; messages found.
- (cond
- ((zerop rsf-number-of-spam) "")
- ((= 1 new-message-count) ", and appears to be spam")
- ((= rsf-number-of-spam new-message-count) ", 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"))))
-
(defun rmail-parse-url (file)
"Parse the supplied URL. Return (list MAILBOX-NAME REMOTE PASSWORD GOT-PASSWORD)
WHERE MAILBOX-NAME is the name of the mailbox suitable as argument to the
(t
(list file nil nil nil))))
+(defun rmail-unrmail-new-mail (from-file)
+ "Replace newly read mail in Babyl format with equivalent mbox format.
+
+FROM-FILE is the Babyl file from which the new mail should be read."
+ (let ((to-file (make-temp-file "rmail"))
+ size)
+ (unrmail from-file to-file)
+ (let ((inhibit-read-only t)
+ (coding-system-for-read 'raw-text)
+ (buffer-undo-list t))
+ (delete-region (point) (point-max))
+ (setq size (nth 1 (insert-file-contents to-file)))
+ (delete-file to-file)
+ size)))
+
+(defun rmail-unrmail-new-mail-maybe (file size)
+ "If newly read mail from FILE is in Babyl format, convert it to mbox format.
+
+SIZE is the original size of the newly read mail.
+Value is the size of the newly read mail after conversion."
+ ;; Detect previous Babyl format files.
+ (let ((case-fold-search nil)
+ (old-file file)
+ new-file)
+ (cond ((looking-at "BABYL OPTIONS:")
+ ;; The new mail is in Babyl version 5 format. Use unrmail
+ ;; to convert it.
+ (setq size (rmail-unrmail-new-mail old-file)))
+ ((looking-at "Version: 5\n")
+ ;; New mail is in Babyl format made by old version of
+ ;; Rmail. Fix the babyl file header and use unrmail to
+ ;; convert it.
+ (let ((buffer-read-only nil)
+ (write-region-annotate-functions nil)
+ (write-region-post-annotation-function nil)
+ (old-file (make-temp-file "rmail")))
+ (insert "BABYL OPTIONS: -*- rmail -*-\n")
+ (forward-line -1)
+ (write-region (point) (point-max) old-file)
+ (setq size (rmail-unrmail-new-mail old-file))
+ (delete-file old-file))))
+ size))
+
(defun rmail-insert-inbox-text (files renamep)
;; Detect a locked file now, so that we avoid moving mail
;; out of the real inbox file. (That could scare people.)
nil
(set-buffer errors)
(subst-char-in-region (point-min) (point-max)
- ?\n ?\ )
+ ?\n ?\s)
(goto-char (point-max))
(skip-chars-backward " \t")
(delete-region (point) (point-max))
(let ((coding-system-for-read 'no-conversion)
size)
(goto-char (point-max))
- (setq size (nth 1 (insert-file-contents tofile)))
+ (setq size
+ ;; If new mail is in Babyl format, convert it to mbox.
+ (rmail-unrmail-new-mail-maybe
+ tofile
+ (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
(setq last-coding-system-used
(coding-system-change-eol-conversion coding 0)))))))
+(defun rmail-ensure-blank-line ()
+ "Ensure a message ends in a blank line.
+Call with point at the end of the message."
+ (unless (bolp)
+ (insert "\n"))
+ (unless (looking-back "\n\n")
+ (insert "\n")))
+
(defun rmail-add-mbox-headers ()
"Validate the RFC2822 format for the new messages.
Point should be at the first new message.
(let ((count 0)
(start (point))
(value "------U-")
- limit)
+ (case-fold-search nil)
+ (delim (concat "\n\n" rmail-unix-mail-delimiter))
+ limit stop)
;; Detect an empty inbox file.
(unless (= start (point-max))
;; Scan the new messages to establish a count and to ensure 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))
- (narrow-to-region start (point))
- (unless (mail-fetch-field rmail-attribute-header)
- (backward-char 1)
- (insert rmail-attribute-header ": " value "\n"))
- (widen))
- (rmail-error-bad-format))
- ;; Move to the next message.
- (if (search-forward "\n\nFrom " nil 'move)
- (forward-char -5))
- (setq start (point))))
+ (if (looking-at rmail-unix-mail-delimiter)
+ (while (not stop)
+ ;; 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))
+ (narrow-to-region start (point))
+ (unless (mail-fetch-field rmail-attribute-header)
+ (backward-char 1)
+ (insert rmail-attribute-header ": " value "\n"))
+ (widen))
+ (rmail-error-bad-format))
+ ;; Move to the next message.
+ (if (not (re-search-forward delim nil 'move))
+ (setq stop t)
+ (goto-char (match-beginning 0))
+ (forward-char 2))
+ (setq start (point)))
+ (rmail-error-bad-format)))
count))))
\f
+(defun rmail-get-header-1 (name)
+ "Subroutine of `rmail-get-header'.
+Narrow to header, call `mail-fetch-field' to find header NAME."
+ (if (search-forward "\n\n" nil t)
+ (progn
+ (narrow-to-region (point-min) (point))
+ (mail-fetch-field name))
+ (rmail-error-bad-format)))
+
(defun rmail-get-header (name &optional msgnum)
"Return the value of message header NAME, nil if it has none.
MSGNUM specifies the message number to get it from.
If MSGNUM is nil, use the current message."
- (with-current-buffer rmail-buffer
- (or msgnum (setq msgnum rmail-current-message))
- (when (> msgnum 0)
- (let (msgbeg end)
- (setq msgbeg (rmail-msgbeg msgnum))
- ;; All access to the buffer's local variables is now finished...
- (save-excursion
- ;; ... so it is ok to go to a different buffer.
- (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char msgbeg)
- (setq end (search-forward "\n\n" nil t))
- (if end
- (progn
- (narrow-to-region msgbeg end)
- (mail-fetch-field name))
- (rmail-error-bad-format msgnum)))))))))
+ (rmail-apply-in-message msgnum 'rmail-get-header-1 name))
+
+(defun rmail-set-header-1 (name value)
+ "Subroutine of `rmail-set-header'.
+Narrow to header, set header NAME to VALUE, replacing existing if present.
+VALUE nil means to remove NAME altogether."
+ (if (search-forward "\n\n" nil t)
+ (progn
+ (forward-char -1)
+ (narrow-to-region (point-min) (point))
+ (goto-char (point-min))
+ (if (re-search-forward (concat "^" (regexp-quote name) ":") nil 'move)
+ (if value
+ (progn
+ (delete-region (point) (line-end-position))
+ (insert " " value))
+ (delete-region (line-beginning-position)
+ (line-beginning-position 2)))
+ (if value (insert name ": " value "\n"))))
+ (rmail-error-bad-format)))
(defun rmail-set-header (name &optional msgnum value)
- "Store VALUE in message header NAME, nil if it has none.
-MSGNUM specifies the message number to operate on.
-If MSGNUM is nil, use the current message."
+ "Set message header NAME to VALUE in message number MSGNUM.
+If MSGNUM is nil, use the current message. NAME and VALUE are strings.
+VALUE may also be nil, meaning to remove the header."
+ (rmail-apply-in-message msgnum 'rmail-set-header-1 name value)
(with-current-buffer rmail-buffer
- (or msgnum (setq msgnum rmail-current-message))
- (when (> msgnum 0)
- (let (msgbeg end)
- (setq msgbeg (rmail-msgbeg msgnum))
- ;; All access to the buffer's local variables is now finished...
- (save-excursion
- ;; ... so it is ok to go to a different buffer.
- (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (goto-char msgbeg)
- (setq end (search-forward "\n\n" nil t))
- (if end (setq end (1- end)))
- (if end
- (progn
- (narrow-to-region msgbeg end)
- (goto-char msgbeg)
- (if (re-search-forward (concat "^"
- (regexp-quote name)
- ":")
- nil t)
- (progn
- (delete-region (point) (line-end-position))
- (insert " " value))
- (goto-char end)
- (insert name ": " value "\n")))
- (rmail-error-bad-format msgnum)))))
- ;; Ensure header changes get saved.
- (if end (set-buffer-modified-p t))))))
+ ;; Ensure header changes get saved.
+ ;; (Note replacing a header with an identical copy modifies.)
+ (set-buffer-modified-p t)
+ ;; However: don't save in mbox format over a Babyl file
+ ;; merely because of this.
+ (rmail-dont-modify-format)))
\f
;;;; *** Rmail Attributes and Keywords ***
MSG specifies the message number to get it from.
If MSG is nil, use the current message."
(let ((value (rmail-get-header rmail-attribute-header msg))
+ (nmax (length rmail-attr-array))
result temp)
- (dotimes (index (length value))
- (setq temp (and (not (= ?- (aref value index)))
- (nth 1 (aref rmail-attr-array index)))
- result
- (cond
- ((and temp result) (format "%s, %s" result temp))
- (temp temp)
- (t result))))
- result))
+ (when value
+ (if (> (length value) nmax)
+ (message "Warning: corrupt attribute header in message")
+ (dotimes (index (length value))
+ (setq temp (and (not (= ?- (aref value index)))
+ (nth 1 (aref rmail-attr-array index)))
+ result
+ (cond
+ ((and temp result) (format "%s, %s" result temp))
+ (temp temp)
+ (t result)))))
+ result)))
(defun rmail-get-keywords (&optional msg)
"Return the message keywords in a comma separated string.
MSG, if non-nil, identifies the message number to use.
If nil, that means the current message."
(or msg (setq msg rmail-current-message))
- (let (blurb attr-names keywords)
+ (let (attr-names keywords)
;; Combine the message attributes and keywords
;; into a comma-separated list.
(setq attr-names (rmail-get-attr-names msg)
((not state) ?-)
(t (nth 0 (aref rmail-attr-array attr)))))
+(defun rmail-set-attribute-1 (attr state)
+ "Subroutine of `rmail-set-attribute'.
+Set Rmail attribute ATTR to STATE in `rmail-attribute-header',
+creating the header if necessary. Returns non-nil if a
+significant attribute change was made."
+ (let ((limit (search-forward "\n\n" nil t))
+ (value (rmail-get-attr-value attr state))
+ (inhibit-read-only t)
+ altered)
+ (goto-char (point-min))
+ (if (search-forward (concat rmail-attribute-header ": ") limit t)
+ ;; If this message already records attributes, just change the
+ ;; value for this one.
+ (let ((missing (- (+ (point) attr) (line-end-position))))
+ ;; Position point at this attribute, adding attributes if necessary.
+ (if (> missing 0)
+ (progn
+ (end-of-line)
+ (insert-char ?- missing)
+ (backward-char 1))
+ (forward-char attr))
+ ;; Change this attribute.
+ (when (/= value (char-after))
+ (setq altered t)
+ (delete-char 1)
+ (insert value)))
+ ;; Otherwise add a header line to record the attributes and set
+ ;; all but this one to no.
+ (let ((header-value "--------"))
+ (aset header-value attr value)
+ (goto-char (if limit (1- limit) (point-max)))
+ (setq altered (/= value ?-))
+ (insert rmail-attribute-header ": " header-value "\n")))
+ altered))
+
(defun rmail-set-attribute (attr state &optional msgnum)
"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
+ATTR is either the index number of the attribute, or a string,
+both from `rmail-attr-array'. MSGNUM is message number to
change; nil means current message."
+ (let ((n 0)
+ (nmax (length rmail-attr-array)))
+ (while (and (stringp attr)
+ (< n nmax))
+ (if (string-equal attr (cadr (aref rmail-attr-array n)))
+ (setq attr n))
+ (setq n (1+ n))))
+ (if (stringp attr)
+ (error "Unknown attribute `%s'" attr))
+ ;; Ask for confirmation before setting any attribute except `unseen'
+ ;; if it would force a format change.
+ (unless (= attr rmail-unseen-attr-index)
+ (rmail-modify-format))
(with-current-buffer rmail-buffer
- (let ((value (rmail-get-attr-value attr state))
- (inhibit-read-only t)
- limit
- altered
- msgbeg)
- (or msgnum (setq msgnum rmail-current-message))
- (when (> msgnum 0)
- ;; The "deleted" attribute is also stored in a special vector
- ;; so update that too.
- (if (= attr rmail-deleted-attr-index)
- (rmail-set-message-deleted-p msgnum state))
- (setq msgbeg (rmail-msgbeg msgnum))
-
- ;; All access to the buffer's local variables is now finished...
- (unwind-protect
- (save-excursion
- ;; ... so it is ok to go to a different buffer.
- (if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
- (save-excursion
- (save-restriction
- (widen)
- ;; Determine if the current state is the desired state.
- (goto-char msgbeg)
- (save-excursion
- (setq limit (search-forward "\n\n" nil t)))
- (if (search-forward (concat rmail-attribute-header ": ") limit t)
- ;; If this message already records attributes,
- ;; just change the value for this one.
- (let ((missing (- (+ (point) attr) (line-end-position))))
- ;; Position point at this attribute,
- ;; adding attributes if necessary.
- (if (> missing 0)
- (progn
- (end-of-line)
- (insert-char ?- missing)
- (backward-char 1))
- (forward-char attr))
- ;; Change this attribute.
- (when (/= value (char-after))
- (setq altered t)
- (delete-char 1)
- (insert value)))
- ;; Otherwise add a header line to record the attributes
- ;; and set all but this one to no.
- (let ((header-value "--------"))
- (aset header-value attr value)
- (goto-char (if limit (- limit 1) (point-max)))
- (setq altered (/= value ?-))
- (insert rmail-attribute-header ": " header-value "\n"))))))
- (if (= msgnum rmail-current-message)
- (rmail-display-labels))))
- ;; If we made a significant change in an attribute,
- ;; mark rmail-buffer modified, so it will be (1) saved
- ;; and (2) displayed in the mode line.
- (if altered
- (set-buffer-modified-p t)))))
+ (or msgnum (setq msgnum rmail-current-message))
+ (when (> msgnum 0)
+ ;; The "deleted" attribute is also stored in a special vector so
+ ;; update that too.
+ (if (= attr rmail-deleted-attr-index)
+ (rmail-set-message-deleted-p msgnum state))
+ (if (prog1
+ (rmail-apply-in-message msgnum 'rmail-set-attribute-1 attr state)
+ (if (= msgnum rmail-current-message)
+ (rmail-display-labels)))
+ ;; Don't save in mbox format over a Babyl file
+ ;; merely because of a change in `unseen' attribute.
+ (if (= attr rmail-unseen-attr-index)
+ (rmail-dont-modify-format)
+ ;; Otherwise, if we modified the file text via the view buffer,
+ ;; mark the main buffer modified too.
+ (set-buffer-modified-p t))))))
(defun rmail-message-attr-p (msg attrs)
- "Return t if the attributes header for message MSG matches regexp ATTRS.
-This function assumes the Rmail buffer is unswapped."
- (save-excursion
- (save-restriction
- (let ((start (rmail-msgbeg msg))
- limit)
- (widen)
- (goto-char start)
- (setq limit (search-forward "\n\n" (rmail-msgend msg) t))
- (goto-char start)
- (and limit
- (search-forward (concat rmail-attribute-header ": ") limit t)
- (looking-at attrs))))))
+ "Return non-nil if message number MSG has attributes matching regexp ATTRS."
+ (let ((value (rmail-get-header rmail-attribute-header msg)))
+ (and value (string-match attrs value))))
(defun rmail-message-unseen-p (msgnum)
- "Test the unseen attribute for message MSGNUM.
-Return non-nil if the unseen attribute is set, nil otherwise."
+ "Return non-nil if message number MSGNUM has the unseen attribute."
(rmail-message-attr-p msgnum "......U"))
-;; Return t if the attributes/keywords line of msg number MSG
-;; contains a match for the regexp LABELS.
+;; FIXME rmail-get-labels does some formatting (eg leading space, `;'
+;; between attributes and labels), so this might not do what you want.
+;; Eg see rmail-sort-by-labels. rmail-get-labels could have an
+;; optional `noformat' argument.
(defun rmail-message-labels-p (msg labels)
+ "Return non-nil if message number MSG has labels matching regexp LABELS."
(string-match labels (rmail-get-labels msg)))
\f
;;;; *** Rmail Message Selection And Support ***
(defun rmail-msgend (n)
+ "Return the start position for message number N."
(marker-position (aref rmail-message-vector (1+ n))))
(defun rmail-msgbeg (n)
+ "Return the end position for message number N."
(marker-position (aref rmail-message-vector n)))
(defun rmail-apply-in-message (msgnum function &rest args)
(save-excursion
;; ... so it is ok to go to a different buffer.
(if (rmail-buffers-swapped-p) (set-buffer rmail-view-buffer))
- (save-excursion
- (save-restriction
- (widen)
+ (save-excursion
+ (save-restriction
+ (widen)
(goto-char msgbeg)
- (narrow-to-region msgbeg msgend)
- (apply function args))))))))
+ (narrow-to-region msgbeg msgend)
+ (apply function args))))))))
+;; Unused (save for commented out code in rmailedit.el).
(defun rmail-widen-to-current-msgbeg (function)
"Call FUNCTION with point at start of internal data of current message.
Assumes that bounds were previously narrowed to display the message in Rmail.
(defun rmail-forget-messages ()
(unwind-protect
(if (vectorp rmail-message-vector)
- (let* ((i 0)
- (v rmail-message-vector)
+ (let* ((v rmail-message-vector)
(n (length v)))
- (while (< i n)
- (move-marker (aref v i) nil)
- (setq i (1+ i)))))
+ (dotimes (i n)
+ (if (aref v i)
+ (move-marker (aref v i) nil)))))
(setq rmail-message-vector nil)
(setq rmail-msgref-vector nil)
(setq rmail-deleted-vector nil)))
;; the entry for message N+1, which marks
;; the end of message N. (N = number of messages).
(setq messages-head (list (point-marker)))
- (rmail-set-message-counters-counter (min (point) point-save))
- (setq messages-after-point total-messages)
+ (setq messages-after-point
+ (or (rmail-set-message-counters-counter (min (point) point-save))
+ 0))
- ;; Determine how many precede point.
- (rmail-set-message-counters-counter)
(setq rmail-total-messages total-messages)
(setq rmail-current-message
(min total-messages
(max 1 (- total-messages messages-after-point))))
- (setq rmail-message-vector
- (apply 'vector (cons (point-min-marker) messages-head))
- rmail-deleted-vector (concat "0" deleted-head)
- rmail-summary-vector (make-vector rmail-total-messages nil)
+
+ ;; Make an element 0 in rmail-message-vector and rmail-deleted-vector
+ ;; which will never be used.
+ (push nil messages-head)
+ (push ?0 deleted-head)
+ (setq rmail-message-vector (apply 'vector messages-head)
+ rmail-deleted-vector (concat deleted-head))
+
+ (setq rmail-summary-vector (make-vector rmail-total-messages nil)
rmail-msgref-vector (make-vector (1+ rmail-total-messages) nil))
+
(let ((i 0))
(while (<= i rmail-total-messages)
(aset rmail-msgref-vector i (list i))
(cons (if (and (search-forward (concat rmail-attribute-header ": ") message-end t)
(looking-at "?D"))
?D
- ?\ ) deleted-head))))
-
-(defun rmail-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)
+ ?\s) deleted-head))))
+
+(defun rmail-set-message-counters-counter (&optional spot-to-find)
+ "Collect the start positions of messages in list `messages-head'.
+Return the number of messages after the one containing SPOT-TO-FIND."
+ (let ((start (point))
+ messages-after-spot)
+ (while (search-backward "\n\nFrom " nil t)
(forward-char 2)
- (rmail-collect-deleted start)
- (setq messages-head (cons (point-marker) messages-head)
- total-messages (1+ total-messages)
- start (point))
- ;; Show progress after every 20 messages or so.
- (if (zerop (% total-messages 20))
- (message "Counting messages...%d" total-messages)))
+ (when (looking-at rmail-unix-mail-delimiter)
+ (if (and (<= (point) spot-to-find)
+ (null messages-after-spot))
+ (setq messages-after-spot total-messages))
+ (rmail-collect-deleted start)
+ (setq messages-head (cons (point-marker) messages-head)
+ total-messages (1+ total-messages)
+ start (point))
+ ;; Show progress after every 20 messages or so.
+ (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 "))
+ (goto-char (point-min))
+ (unless (not (looking-at rmail-unix-mail-delimiter))
+ (if (and (<= (point) spot-to-find)
+ (null messages-after-spot))
+ (setq messages-after-spot total-messages))
(rmail-collect-deleted start)
(setq messages-head (cons (point-marker) messages-head)
- total-messages (1+ total-messages)))))
+ total-messages (1+ total-messages)))
+ messages-after-spot))
\f
;; Display a message.
(if (numberp arg)
(if (> arg 0) 'normal 'full)
(if (rmail-msg-is-pruned) 'full 'normal))))
- (rmail-show-message-maybe)))
+ (rmail-show-message)))
(defun rmail-beginning-of-message ()
"Show current message starting from the beginning."
(interactive)
- (let ((rmail-show-message-hook
- (list (function (lambda ()
- (goto-char (point-min)))))))
- (rmail-show-message-maybe rmail-current-message)))
+ (let ((rmail-show-message-hook '((lambda () (goto-char (point-min)))))
+ (rmail-header-style (with-current-buffer (if (rmail-buffers-swapped-p)
+ rmail-view-buffer
+ rmail-buffer)
+ rmail-header-style)))
+ (rmail-show-message rmail-current-message)))
(defun rmail-end-of-message ()
"Show bottom of current message."
(interactive)
- (let ((rmail-show-message-hook
- (list (function (lambda ()
- (goto-char (point-max))
- (recenter (1- (window-height))))))))
- (rmail-show-message-maybe rmail-current-message)))
+ (let ((rmail-show-message-hook '((lambda ()
+ (goto-char (point-max))
+ (recenter (1- (window-height))))))
+ (rmail-header-style (with-current-buffer (if (rmail-buffers-swapped-p)
+ rmail-view-buffer
+ rmail-buffer)
+ rmail-header-style)))
+ (rmail-show-message rmail-current-message)))
(defun rmail-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'."
+ ;; FIXME s-r not needed? Use rmail-get-header?
+ ;; We have not narrowed to the headers at ths point?
(save-restriction
(let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t)))
(when mail-followup-to
(erase-buffer)
"No mail."))))
-(defun rmail-show-message-maybe (&optional n no-summary)
+(defun rmail-show-message (&optional n no-summary)
"Show message number N (prefix argument), counting from start of file.
If summary buffer is currently displayed, update current message there also.
N defaults to the current message."
(rmail-swap-buffers-maybe)
(rmail-maybe-set-message-counters)
(widen)
- (let ((blurb (rmail-show-message n)))
+ (let ((blurb (rmail-show-message-1 n)))
(or (zerop rmail-total-messages)
(progn
(when mail-mailing-lists
(or (not content-type-header)
(string-match text-regexp content-type-header)))))
-(defun rmail-show-message (&optional msg)
+(defcustom rmail-show-message-verbose-min 200000
+ "Message size at which to show progress messages for displaying it."
+ :type 'integer
+ :group 'rmail
+ :version "23.1")
+
+(defun rmail-show-message-1 (&optional msg)
"Show message MSG (default: current message) using `rmail-view-buffer'.
Return text to display in the minibuffer if MSG is out of
range (displaying a reasonable choice as well), nil otherwise.
(t (setq rmail-current-message msg)))
(with-current-buffer rmail-buffer
(setq header-style rmail-header-style)
- ;; Mark the message as seen, bracket the message in the mail
- ;; buffer and determine the coding system the transfer encoding.
+ ;; Mark the message as seen
(rmail-set-attribute rmail-unseen-attr-index nil)
+ ;; bracket the message in the mail
+ ;; buffer and determine the coding system the transfer encoding.
(rmail-swap-buffers-maybe)
(setq beg (rmail-msgbeg msg)
end (rmail-msgend msg))
+ (when (> (- end beg) rmail-show-message-verbose-min)
+ (message "Showing message %d" msg))
(narrow-to-region beg end)
(goto-char beg)
(setq body-start (search-forward "\n\n" nil t))
(rmail-display-labels)
(rmail-swap-buffers)
(setq rmail-buffer-swapped t)
- (run-hooks 'rmail-show-message-hook)))
+ (run-hooks 'rmail-show-message-hook)
+ (when (> (- end beg) rmail-show-message-verbose-min)
+ (message "Showing message %d...done" msg))))
blurb))
(defun rmail-copy-headers (beg end &optional ignored-headers)
;; Handle the case where all headers should be copied.
((eq rmail-header-style 'full)
(prepend-to-buffer rmail-view-buffer beg (point-max))
- ;; rmail-show-message expects this function to leave point
+ ;; rmail-show-message-1 expects this function to leave point
;; at the end of the headers.
- (with-current-buffer rmail-view-buffer
- (search-forward "\n\n" nil t)))
+
+ (let ((len (- (point-max) beg)))
+ (with-current-buffer rmail-view-buffer
+ (goto-char (1+ len)))))
+
;; Handle the case where the headers matching the displayed
;; headers regexp should be copied.
((and rmail-displayed-headers (null ignored-headers))
(forward-line -1))
(insert "X-Coding-System: "
(symbol-name coding))))
- (rmail-show-message-maybe))))))
+ (rmail-show-message))))))
-;; Find all occurrences of certain fields, and highlight them.
(defun rmail-highlight-headers ()
- ;; Do this only if the system supports faces.
- (if (and (fboundp 'internal-find-face)
- rmail-highlighted-headers)
+ "Highlight the headers specified by `rmail-highlighted-headers'.
+Uses the face `rmail-highlight'."
+ (if rmail-highlighted-headers
(save-excursion
(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 'rmail-highlight
- (if (face-differs-from-default-p 'bold)
- 'bold 'highlight)))
;; List of overlays to reuse.
(overlays rmail-overlay-list))
(goto-char (point-min))
(progn
(setq overlay (car overlays)
overlays (cdr overlays))
- (overlay-put overlay 'face face)
+ (overlay-put overlay 'face 'rmail-highlight)
(move-overlay overlay beg (point)))
;; Make a new overlay and add it to
;; rmail-overlay-list.
(setq overlay (make-overlay beg (point)))
- (overlay-put overlay 'face face)
+ (overlay-put overlay 'face 'rmail-highlight)
(setq rmail-overlay-list
(cons overlay rmail-overlay-list))))))))))
(rmail-delete-forward)
(if (string= "/dev/null" folder)
(rmail-delete-message)
- (rmail-output folder 1 t)
+ (rmail-output folder 1)
(setq d nil))))
(setq d (cdr d))))))
\f
(interactive "p")
(set-buffer rmail-buffer)
(rmail-maybe-set-message-counters)
- (rmail-show-message-maybe (+ rmail-current-message n)))
+ (rmail-show-message (+ rmail-current-message n)))
(defun rmail-previous-message (n)
"Show previous message whether deleted or not.
(if (not (rmail-message-deleted-p current))
(setq lastwin current n (1+ n))))
(if (/= lastwin rmail-current-message)
- (progn (rmail-show-message-maybe lastwin)
+ (progn (rmail-show-message lastwin)
t)
(if (< n 0)
(message "No previous nondeleted message"))
"Show first message in file."
(interactive)
(rmail-maybe-set-message-counters)
- (rmail-show-message-maybe 1))
+ (rmail-show-message 1))
(defun rmail-last-message ()
"Show last message in file."
(interactive)
(rmail-maybe-set-message-counters)
- (rmail-show-message-maybe rmail-total-messages))
+ (rmail-show-message rmail-total-messages))
(defun rmail-what-message ()
"For debugging Rmail: find the message number that point is in."
(setq n (+ n (if reversep 1 -1))))
(if found
(progn
- (rmail-show-message-maybe msg)
+ (rmail-show-message msg)
;; Search forward (if this is a normal search) or backward
;; (if this is a reverse search) through this message to
;; position point. This search may fail because REGEXP
(message "%sRmail search for %s...done"
(if reversep "Reverse " "")
regexp))
- (rmail-show-message-maybe orig-message)
+ (rmail-show-message orig-message)
(if opoint (goto-char opoint))
(ding)
(message "Search failed: %s" regexp)))))
(setq subject (substring subject (match-end 0))))
(if (string-match "[ \t]+\\'" subject)
(setq subject (substring subject 0 (match-beginning 0))))
+ ;; If Subject is long, mailers will break it into several lines at
+ ;; arbitrary places, so normalize whitespace by replacing every
+ ;; run of whitespace characters with a single space.
+ (setq subject (replace-regexp-in-string "[ \t\n]+" " " subject))
subject))
(defun rmail-simplified-subject-regexp ()
(if done (setq found i)))
(setq n (if forward (1- n) (1+ n))))
(if found
- (rmail-show-message-maybe found)
+ (rmail-show-message found)
(error "No %s message with same subject"
(if forward "following" "previous")))))
;;;; *** Rmail Message Deletion Commands ***
(defun rmail-message-deleted-p (n)
+ "Return non-nil if message number N is deleted (in `rmail-deleted-vector')."
(= (aref rmail-deleted-vector n) ?D))
(defun rmail-set-message-deleted-p (n state)
- (aset rmail-deleted-vector n (if state ?D ?\ )))
+ "Set the deleted state of message number N (in `rmail-deleted-vector').
+STATE non-nil means mark as deleted."
+ (aset rmail-deleted-vector n (if state ?D ?\s)))
(defun rmail-delete-message ()
"Delete this message and stay on it."
(if (= msg 0)
(error "No previous deleted message")
(if (/= msg rmail-current-message)
- (rmail-show-message-maybe msg))
+ (rmail-show-message msg))
(rmail-set-attribute rmail-deleted-attr-index nil)
(if (rmail-summary-exists)
(with-current-buffer rmail-summary-buffer
newnum)))
(defun rmail-expunge-confirmed ()
- "Return t if deleted message should be expunged. If necessary, ask the user.
-See also user-option `rmail-confirm-expunge'."
+ "Return t if expunge is needed and desirable.
+If `rmail-confirm-expunge' is non-nil, ask user to confirm."
(set-buffer rmail-buffer)
- (or (not (stringp rmail-deleted-vector))
- (not (string-match "D" rmail-deleted-vector))
- (null rmail-confirm-expunge)
- (funcall rmail-confirm-expunge
- "Erase deleted messages from Rmail file? ")))
+ (and (stringp rmail-deleted-vector)
+ (string-match "D" rmail-deleted-vector)
+ (if rmail-confirm-expunge
+ (funcall rmail-confirm-expunge
+ "Erase deleted messages from Rmail file? ")
+ t)))
(defun rmail-only-expunge (&optional dont-show)
"Actually erase all deleted messages in the file."
(setq rmail-current-message new-message-number
rmail-total-messages counter
rmail-message-vector (apply 'vector messages-head)
- rmail-deleted-vector (make-string (1+ counter) ?\ )
+ rmail-deleted-vector (make-string (1+ counter) ?\s)
rmail-summary-vector (vconcat (nreverse new-summary))
rmail-msgref-vector (apply 'vector (nreverse new-msgref))
win t)))
(if (not win)
(narrow-to-region (- (buffer-size) omin) (- (buffer-size) omax)))
(if (not dont-show)
- (rmail-show-message-maybe (min rmail-current-message rmail-total-messages)))
+ (rmail-show-message (min rmail-current-message rmail-total-messages)))
(if rmail-enable-mime
(goto-char (+ (point-min) opoint))
(goto-char (+ (point) opoint))))))
+;; The DONT-SHOW argument is new in 23. Does not seem very important.
(defun rmail-expunge (&optional dont-show)
- "Erase deleted messages from Rmail file and summary buffer."
+ "Erase deleted messages from Rmail file and summary buffer.
+This always shows a message (so as not to leave the Rmail buffer
+unswapped), and always updates any summary (so that it remains
+consistent with the Rmail buffer). If DONT-SHOW is non-nil, it
+does not pop any summary buffer."
(interactive)
(when (rmail-expunge-confirmed)
- (let ((old-total rmail-total-messages)
- (opoint (with-current-buffer rmail-buffer
- (when (rmail-buffers-swapped-p)
- (point)))))
- (rmail-only-expunge dont-show)
+ (rmail-modify-format)
+ (let ((was-deleted (rmail-message-deleted-p rmail-current-message))
+ (was-swapped (rmail-buffers-swapped-p)))
+ (rmail-only-expunge t)
+ ;; We always update the summary buffer, so that the contents
+ ;; remain consistent with the rmail buffer.
+ ;; The only difference is, in the dont-show case, we use a
+ ;; cut-down version of rmail-select-summary that does not pop
+ ;; the summary buffer. It's only used by rmail-quit, which is
+ ;; just going to bury any summary immediately after. If we made
+ ;; rmail-quit bury the summary first, dont-show could be removed.
+ ;; But the expunge might not be confirmed...
(if (rmail-summary-exists)
- (rmail-select-summary (rmail-update-summary))
- (rmail-show-message rmail-current-message)
- (if (and (eq old-total rmail-total-messages) opoint)
- (goto-char opoint))))))
+ (if dont-show
+ (let ((total rmail-total-messages))
+ (with-current-buffer rmail-summary-buffer
+ (let ((rmail-total-messages total))
+ (rmail-update-summary))))
+ (rmail-select-summary (rmail-update-summary))))
+ ;; We always show a message, because (rmail-only-expunge t)
+ ;; leaves the rmail buffer unswapped.
+ ;; If we expunged the current message, a new one is current now,
+ ;; so show it. If we weren't showing a message, show it.
+ (if (or was-deleted (not was-swapped))
+ (rmail-show-message-1 rmail-current-message)
+ ;; We can just show the same message that was being shown before.
+ (rmail-display-labels)
+ (rmail-swap-buffers)
+ (setq rmail-buffer-swapped t)))))
\f
;;;; *** Rmail Mailing Commands ***
replybuffer sendactions same-window others)
(let (yank-action)
(if replybuffer
+ ;; The function used here must behave like insert-buffer wrt
+ ;; point and mark (see doc of sc-cite-original).
(setq yank-action (list 'insert-buffer replybuffer)))
(setq others (cons (cons "cc" cc) others))
(setq others (cons (cons "in-reply-to" in-reply-to) others))
(interactive)
(rmail-start-mail nil nil nil nil nil rmail-view-buffer))
+;; FIXME should complain if there is nothing to continue.
(defun rmail-continue ()
"Continue composing outgoing message previously being composed."
(interactive)
(let (from reply-to cc subject date to message-id references
resent-to resent-cc resent-reply-to
(msgnum rmail-current-message))
- (save-excursion
- (save-restriction
- (widen)
- (if (rmail-buffers-swapped-p)
- (narrow-to-region
- (goto-char (point-min))
- (search-forward "\n\n" nil 'move))
- (goto-char (rmail-msgbeg rmail-current-message))
- (forward-line 1)
- (narrow-to-region
- (point)
- (search-forward "\n\n"
- (rmail-msgend rmail-current-message)
- 'move)))
- (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)
- ;; Bug#512. It's inappropriate to reply to these addresses.
-;;; 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) ""))))))
-
+ (rmail-apply-in-message
+ rmail-current-message
+ (lambda ()
+ (search-forward "\n\n" nil 'move)
+ (narrow-to-region (point-min) (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)
+ ;; Bug#512. It's inappropriate to reply to these addresses.
+;;; 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.
;; Bug#512. It's inappropriate to reply to these addresses.
;;; (if (and resent-to (not (equal resent-to "")))
(aref rmail-msgref-vector msgnum))
rmail-answered-attr-index))
nil
- (list (cons "References" (concat (mapconcat 'identity references " ")
- " " message-id))))))
+ (if (or references message-id)
+ (list (cons "References" (if references
+ (concat
+ (mapconcat 'identity references " ")
+ " " message-id)
+ message-id)))))))
\f
(defun rmail-mark-message (buffer msgnum-list attribute)
"Give BUFFER's message number in MSGNUM-LIST the attribute ATTRIBUTE.
(end (match-end 1)))
;; Trim whitespace which above regexp match allows
(while (and (< start end)
- (memq (aref from start) '(?\t ?\ )))
+ (memq (aref from start) '(?\t ?\s)))
(setq start (1+ start)))
(while (and (< start end)
- (memq (aref from (1- end)) '(?\t ?\ )))
+ (memq (aref from (1- end)) '(?\t ?\s)))
(setq end (1- end)))
(let ((field (substring from start end)))
(if date (setq field (concat "message from " field " on " date)))
(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$"
"A regexp that matches the header of a MIME body part with a failed message.")
+;; This is a cut-down version of rmail-clear-headers from Emacs 22.
+;; It doesn't have the same functionality, hence the name change.
+(defun rmail-delete-headers (regexp)
+ "Delete any mail headers matching REGEXP.
+The message should be narrowed to just the headers."
+ (when regexp
+ (goto-char (point-min))
+ (while (re-search-forward regexp nil t)
+ (beginning-of-line)
+ ;; This code from Emacs 22 doesn't seem right, since r-n-h is
+ ;; just for display.
+;;; (if (looking-at rmail-nonignored-headers)
+;;; (forward-line 1)
+ (delete-region (point)
+ (save-excursion
+ (if (re-search-forward "\n[^ \t]" nil t)
+ (1- (point))
+ (point-max)))))))
+
(defun rmail-retry-failure ()
"Edit a mail message which is based on the contents of the current message.
For a message rejected by the mail system, extract the interesting headers and
(let ((rmail-this-buffer (current-buffer))
(msgnum rmail-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
- (mail-fetch-field "Content-Type") ))))
+ (content-type (rmail-get-header "Content-Type")))
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t))
;; Insert original text as initial text of new draft message.
;; Bind inhibit-read-only since the header delimiter
;; of the previous message was probably read-only.
- (let ((inhibit-read-only t)
- rmail-displayed-headers
- rmail-ignored-headers)
+ (let ((inhibit-read-only t))
(erase-buffer)
(insert-buffer-substring rmail-this-buffer
bounce-start bounce-end)
(mail-sendmail-delimit-header)
(save-restriction
(narrow-to-region (point-min) (mail-header-end))
+ (rmail-delete-headers rmail-retry-ignored-headers)
+ (rmail-delete-headers "^\\(sender\\|return-path\\|received\\):")
(setq resending (mail-fetch-field "resent-to"))
(if mail-self-blind
(if resending
(define-key rmail-speedbar-key-map "M"
'rmail-speedbar-move-message-to-folder-on-line)))
+;; Mouse-3.
(defvar rmail-speedbar-menu-items
'(["Read Folder" speedbar-edit-line t]
["Move message to folder" rmail-speedbar-move-message-to-folder-on-line
(df (directory-files (with-current-buffer buffer
default-directory)
nil rmail-speedbar-match-folder-regexp)))
- (while df
- (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
- 'rmail-speedbar-move-message (car df))
- (speedbar-insert-button (car df) 'speedbar-file-face 'highlight
- 'rmail-speedbar-find-file nil t)
- (setq df (cdr df)))))))
+ (dolist (file df)
+ (when (file-regular-p file)
+ (speedbar-insert-button "<M>" 'speedbar-button-face 'highlight
+ 'rmail-speedbar-move-message file)
+ (speedbar-insert-button file 'speedbar-file-face 'highlight
+ 'rmail-speedbar-find-file nil t)))))))
(defun rmail-speedbar-button (text token indent)
"Execute an rmail command specified by TEXT.
TOKEN and INDENT are not used."
(speedbar-with-attached-buffer
(message "Loading in RMAIL file %s..." text)
- (find-file text)))
+ (rmail text)))
(defun rmail-speedbar-move-message-to-folder-on-line ()
"If the current line is a folder, move current message to it."
TEXT and INDENT are not used."
(speedbar-with-attached-buffer
(message "Moving message to %s" token)
- (rmail-output token)))
+ ;; expand-file-name is needed due to the unhelpful way in which
+ ;; rmail-output expands non-absolute filenames against rmail-default-file.
+ ;; What is the point of that, anyway?
+ (rmail-output (expand-file-name token))))
-; Functions for setting, getting and encoding the POP password.
-; The password is encoded to prevent it from being easily accessible
-; to "prying eyes." Obviously, this encoding isn't "real security,"
-; nor is it meant to be.
+;; Functions for setting, getting and encoding the POP password.
+;; The password is encoded to prevent it from being easily accessible
+;; to "prying eyes." Obviously, this encoding isn't "real security,"
+;; nor is it meant to be.
;;;###autoload
(defun rmail-set-remote-password (password)
;;;; Desktop support
(defun rmail-restore-desktop-buffer (desktop-buffer-file-name
- desktop-buffer-name
- desktop-buffer-misc)
+ desktop-buffer-name
+ desktop-buffer-misc)
"Restore an rmail buffer specified in a desktop file."
(condition-case error
(progn
- (rmail-input desktop-buffer-file-name)
- (if (eq major-mode 'rmail-mode)
- (current-buffer)
- rmail-buffer))
+ (rmail-input desktop-buffer-file-name)
+ (if (eq major-mode 'rmail-mode)
+ (current-buffer)
+ rmail-buffer))
(file-locked
(kill-buffer (current-buffer))
nil)))
(add-to-list 'desktop-buffer-mode-handlers
'(rmail-mode . rmail-restore-desktop-buffer))
+;; We use this to record the encoding of the current message before
+;; saving the message collection.
+(defvar rmail-message-encoding nil)
+
;; Used in `write-region-annotate-functions' to write rmail files.
(defun rmail-write-region-annotate (start end)
(when (and (null start) (rmail-buffers-swapped-p))
+ (setq rmail-message-encoding buffer-file-coding-system)
(set-buffer rmail-view-buffer)
(widen)
nil))
+;; Used to restore the encoding of the buffer where we show the
+;; current message, after we save the message collection. This is
+;; needed because rmail-write-region-annotate switches buffers behind
+;; save-file's back, with the side effect that last-coding-system-used
+;; is assigned to buffer-file-coding-system of the wrong buffer.
+(defun rmail-after-save-hook ()
+ (if (or (eq rmail-view-buffer (current-buffer))
+ (eq rmail-buffer (current-buffer)))
+ (with-current-buffer
+ (if (rmail-buffers-swapped-p) rmail-buffer rmail-view-buffer)
+ (setq buffer-file-coding-system rmail-message-encoding))))
+(add-hook 'after-save-hook 'rmail-after-save-hook)
+
+\f
+;;; Start of automatically extracted autoloads.
+\f
+;;;### (autoloads (rmail-edit-current-message) "rmailedit" "rmailedit.el"
+;;;;;; "31f0128d57ee5aefe13ec6060a5c63cc")
+;;; Generated autoloads from rmailedit.el
+
+(autoload 'rmail-edit-current-message "rmailedit" "\
+Edit the contents of this message.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (rmail-next-labeled-message rmail-previous-labeled-message
+;;;;;; rmail-read-label rmail-kill-label rmail-add-label) "rmailkwd"
+;;;;;; "rmailkwd.el" "2e986921026eea971b49e91f53967f77")
+;;; Generated autoloads from rmailkwd.el
+
+(autoload 'rmail-add-label "rmailkwd" "\
+Add LABEL to labels associated with current RMAIL message.
+Completes (see `rmail-read-label') over known labels when reading.
+LABEL may be a symbol or string. Only one label is allowed.
+
+\(fn LABEL)" t nil)
+
+(autoload 'rmail-kill-label "rmailkwd" "\
+Remove LABEL from labels associated with current RMAIL message.
+Completes (see `rmail-read-label') over known labels when reading.
+LABEL may be a symbol or string. Only one label is allowed.
+
+\(fn LABEL)" t nil)
+
+(autoload 'rmail-read-label "rmailkwd" "\
+Read a label with completion, prompting with PROMPT.
+Completions are chosen from `rmail-label-obarray'. The default
+is `rmail-last-label', if that is non-nil. Updates `rmail-last-label'
+according to the choice made, and returns a symbol.
+
+\(fn PROMPT)" nil nil)
+
+(autoload 'rmail-previous-labeled-message "rmailkwd" "\
+Show previous message with one of the labels LABELS.
+LABELS should be a comma-separated list of label names.
+If LABELS is empty, the last set of labels specified is used.
+With prefix argument N moves backward N messages with these labels.
+
+\(fn N LABELS)" t nil)
+
+(autoload 'rmail-next-labeled-message "rmailkwd" "\
+Show next message with one of the labels LABELS.
+LABELS should be a comma-separated list of label names.
+If LABELS is empty, the last set of labels specified is used.
+With prefix argument N moves forward N messages with these labels.
+
+\(fn N LABELS)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (rmail-mime) "rmailmm" "rmailmm.el" "04becfcbd937ebfb3020515f84e79d0a")
+;;; Generated autoloads from rmailmm.el
+
+(autoload 'rmail-mime "rmailmm" "\
+Process the current Rmail message as a MIME message.
+This creates a temporary \"*RMAIL*\" buffer holding a decoded
+copy of the message. Inline content-types are handled according to
+`rmail-mime-media-type-handlers-alist'. By default, this
+displays text and multipart messages, and offers to download
+attachments as specfied by `rmail-mime-attachment-dirs-alist'.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (set-rmail-inbox-list) "rmailmsc" "rmailmsc.el"
+;;;;;; "de01c37c81339201034a01732b97f44e")
+;;; Generated autoloads from rmailmsc.el
+
+(autoload 'set-rmail-inbox-list "rmailmsc" "\
+Set the inbox list of the current RMAIL file to FILE-NAME.
+You can specify one file name, or several names separated by commas.
+If FILE-NAME is empty, remove any existing inbox list.
+
+This applies only to the current session.
+
+\(fn FILE-NAME)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (rmail-sort-by-labels rmail-sort-by-lines rmail-sort-by-correspondent
+;;;;;; rmail-sort-by-recipient rmail-sort-by-author rmail-sort-by-subject
+;;;;;; rmail-sort-by-date) "rmailsort" "rmailsort.el" "3f2b10b0272ea56cb604f29330d95fc4")
+;;; Generated autoloads from rmailsort.el
+
+(autoload 'rmail-sort-by-date "rmailsort" "\
+Sort messages of current Rmail buffer by \"Date\" header.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+\(fn REVERSE)" t nil)
+
+(autoload 'rmail-sort-by-subject "rmailsort" "\
+Sort messages of current Rmail buffer by \"Subject\" header.
+Ignores any \"Re: \" prefix. If prefix argument REVERSE is
+non-nil, sorts in reverse order.
+
+\(fn REVERSE)" t nil)
+
+(autoload 'rmail-sort-by-author "rmailsort" "\
+Sort messages of current Rmail buffer by author.
+This uses either the \"From\" or \"Sender\" header, downcased.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+\(fn REVERSE)" t nil)
+
+(autoload 'rmail-sort-by-recipient "rmailsort" "\
+Sort messages of current Rmail buffer by recipient.
+This uses either the \"To\" or \"Apparently-To\" header, downcased.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+\(fn REVERSE)" t nil)
+
+(autoload 'rmail-sort-by-correspondent "rmailsort" "\
+Sort messages of current Rmail buffer by other correspondent.
+This uses either the \"From\", \"Sender\", \"To\", or
+\"Apparently-To\" header, downcased. Uses the first header not
+excluded by `rmail-dont-reply-to-names'. If prefix argument
+REVERSE is non-nil, sorts in reverse order.
+
+\(fn REVERSE)" t nil)
+
+(autoload 'rmail-sort-by-lines "rmailsort" "\
+Sort messages of current Rmail buffer by the number of lines.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+\(fn REVERSE)" t nil)
+
+(autoload 'rmail-sort-by-labels "rmailsort" "\
+Sort messages of current Rmail buffer by labels.
+LABELS is a comma-separated list of labels. The order of these
+labels specifies the order of messages: messages with the first
+label come first, messages with the second label come second, and
+so on. Messages that have none of these labels come last.
+If prefix argument REVERSE is non-nil, sorts in reverse order.
+
+\(fn REVERSE LABELS)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (rmail-summary-by-senders rmail-summary-by-topic
+;;;;;; rmail-summary-by-regexp rmail-summary-by-recipients rmail-summary-by-labels
+;;;;;; rmail-summary) "rmailsum" "rmailsum.el" "d7d82233836cae1295ffa85f7371f857")
+;;; Generated autoloads from rmailsum.el
+
+(autoload 'rmail-summary "rmailsum" "\
+Display a summary of all messages, one line per message.
+
+\(fn)" t nil)
+
+(autoload 'rmail-summary-by-labels "rmailsum" "\
+Display a summary of all messages with one or more LABELS.
+LABELS should be a string containing the desired labels, separated by commas.
+
+\(fn LABELS)" t nil)
+
+(autoload 'rmail-summary-by-recipients "rmailsum" "\
+Display a summary of all messages with the given RECIPIENTS.
+Normally checks the To, From and Cc fields of headers;
+but if PRIMARY-ONLY is non-nil (prefix arg given),
+ only look in the To and From fields.
+RECIPIENTS is a string of regexps separated by commas.
+
+\(fn RECIPIENTS &optional PRIMARY-ONLY)" t nil)
+
+(autoload 'rmail-summary-by-regexp "rmailsum" "\
+Display a summary of all messages according to regexp REGEXP.
+If the regular expression is found in the header of the message
+\(including in the date and other lines, as well as the subject line),
+Emacs will list the message in the summary.
+
+\(fn REGEXP)" t nil)
+
+(autoload 'rmail-summary-by-topic "rmailsum" "\
+Display a summary of all messages with the given SUBJECT.
+Normally checks just the Subject field of headers; but with prefix
+argument WHOLE-MESSAGE is non-nil, looks in the whole message.
+SUBJECT is a string of regexps separated by commas.
+
+\(fn SUBJECT &optional WHOLE-MESSAGE)" t nil)
+
+(autoload 'rmail-summary-by-senders "rmailsum" "\
+Display a summary of all messages whose \"From\" field matches SENDERS.
+SENDERS is a string of regexps separated by commas.
+
+\(fn SENDERS)" t nil)
+
+;;;***
+\f
+;;;### (autoloads (unforward-rmail-message undigestify-rmail-message)
+;;;;;; "undigest" "undigest.el" "b691540ddff5c394e9ebc3517051445f")
+;;; Generated autoloads from undigest.el
+
+(autoload 'undigestify-rmail-message "undigest" "\
+Break up a digest message into its constituent messages.
+Leaves original message, deleted, before the undigestified messages.
+
+\(fn)" t nil)
+
+(autoload 'unforward-rmail-message "undigest" "\
+Extract a forwarded message from the containing message.
+This puts the forwarded message into a separate rmail message
+following the containing message.
+
+\(fn)" t nil)
+
+;;;***
+\f
+;;; End of automatically extracted autoloads.
+
+
(provide 'rmail)
;; arch-tag: 65d257d3-c281-4a65-9c38-e61af95af2f0
HCoop / bpt / emacs.git / blobdiff