;;; 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
+;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
;; Free Software Foundation, Inc.
;; Maintainer: FSF
;; This file is part of GNU Emacs.
-;; GNU Emacs is free software; you can redistribute it and/or modify
+;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 3, or (at your option)
-;; any later version.
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
:group 'rmail-retrieve
:type '(repeat (directory)))
+(declare-function mail-position-on-field "sendmail" (field &optional soft))
+(declare-function mail-text-start "sendmail" ())
+(declare-function rmail-update-summary "rmailsum" (&rest ignore))
+
(defun rmail-probe (prog)
"Determine what flavor of movemail PROG is.
We do this by executing it with `--version' and analyzing its output."
(dolist (dir (append rmail-movemail-search-path exec-path
(list exec-directory)))
(when (and dir (file-accessible-directory-p dir))
- (let ((progname (expand-file-name "movemail" dir)))
+ ;; Previously, this didn't have to work on Windows, because
+ ;; rmail-insert-inbox-text before r1.439 fell back to using
+ ;; (expand-file-name "movemail" exec-directory) and just
+ ;; assuming it would work.
+ ;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00087.html
+ (let ((progname (expand-file-name
+ (concat "movemail"
+ (if (memq system-type '(ms-dos windows-nt))
+ ".exe")) dir)))
(when (and (not (file-directory-p progname))
(file-executable-p progname))
(let ((x (rmail-probe progname)))
"*Regexp to match X header fields that Rmail should show.
This regexp overrides `rmail-ignored-headers'; if both this regexp
and that one match a certain header field, Rmail shows the field.
+If this is nil, ignore all header fields in `rmail-ignored-headers'.
This variable is used for reformatting the message header,
which normally happens once for each message,
To make a change in this variable take effect
for a message that you have already viewed,
go to that message and type \\[rmail-toggle-header] twice."
- :type 'regexp
+ :type '(choice (const nil) (regexp))
:group 'rmail-headers)
;;;###autoload
;;;###autoload
(defcustom rmail-highlighted-headers "^From:\\|^Subject:" "\
*Regexp to match Header fields that Rmail should normally highlight.
-A value of nil means don't highlight.
-See also `rmail-highlight-face'."
+A value of nil means don't highlight."
:type 'regexp
:group 'rmail-headers)
(defface rmail-highlight
- '((t :default highlight))
+ '((t (:inherit highlight)))
"Face to use for highlighting the most important header fields."
:group 'rmail-headers
:version "22.1")
-;;;###autoload
-(defcustom rmail-highlight-face 'rmail-highlight "\
-*Face used by Rmail for highlighting headers."
- :type '(choice (const :tag "Default" nil)
- face)
- :group 'rmail-headers)
+(defface rmail-header-name
+ '((t (:inherit font-lock-function-name-face)))
+ "Face to use for highlighting the header names."
+ :group 'rmail-headers
+ :version "23.1")
;;;###autoload
(defcustom rmail-delete-after-output nil "\
(cite-prefix "a-z")
(cite-suffix (concat cite-prefix "0-9_.@-`'\"")))
(list '("^\\(From\\|Sender\\|Resent-From\\):"
- . font-lock-function-name-face)
- '("^Reply-To:.*$" . font-lock-function-name-face)
- '("^Subject:" . font-lock-comment-face)
- '("^X-Spam-Status:" . font-lock-keyword-face)
+ . 'rmail-header-name)
+ '("^Reply-To:.*$" . 'rmail-header-name)
+ '("^Subject:" . 'rmail-header-name)
+ '("^X-Spam-Status:" . 'rmail-header-name)
'("^\\(To\\|Apparently-To\\|Cc\\|Newsgroups\\):"
- . font-lock-keyword-face)
+ . 'rmail-header-name)
;; Use MATCH-ANCHORED to effectively anchor the regexp left side.
`(,cite-chars
(,(concat "\\=[ \t]*"
(1 font-lock-comment-delimiter-face nil t)
(5 font-lock-comment-face nil t)))
'("^\\(X-[a-z0-9-]+\\|In-reply-to\\|Date\\):.*\\(\n[ \t]+.*\\)*$"
- . font-lock-string-face))))
+ . 'rmail-header-name))))
"Additional expressions to highlight in Rmail mode.")
;; Perform BODY in the summary buffer
\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))
+(declare-function rfc822-addresses "rfc822" (header-text))
+(declare-function mail-abbrev-make-syntax-table "mailabbrev.el" ())
+(declare-function mail-sendmail-delimit-header "sendmail" ())
+(declare-function mail-header-end "sendmail" ())
+
;; RLK feature not added in this version:
;; argument specifies inbox file or files in various ways.
;; in case of multiple inboxes that need moving.
(concat ".newmail-"
(file-name-nondirectory
- (if (memq system-type '(windows-nt cygwin))
- ;; cannot have "po:" in file name
- (substring file 3)
+ (if (memq system-type '(windows-nt cygwin ms-dos))
+ ;; cannot have colons in file name
+ (replace-regexp-in-string ":" "-" file)
file)))
;; Use the directory of this rmail file
;; because it's a nuisance to use the homedir
(save-restriction
(while (not (eobp))
(setq start (point))
- (cond ((looking-at "BABYL OPTIONS:");Babyl header
+ (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))
(save-excursion
(skip-chars-forward " \t\n")
(point)))
- (save-excursion
- (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
+ ;; 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 `rmail-decode-region' which should
+ ;; be correct.
+ (let* ((header-end
+ (progn
(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
+ (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
- (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
+ (goto-char start)
+ (re-search-forward
+ "^content-transfer-encoding:\\(\n?[\t ]\\)*quoted-printable\\(\n?[\t ]\\)*"
+ header-end t)))
+ (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 rmail-enable-mime
- (not rmail-enable-multibyte)
- (let ((mime-charset
- (if (and rmail-decode-mime-charset
- (save-excursion
- (goto-char start)
- (search-forward "\n\n" nil t)
- (let ((case-fold-search t))
- (re-search-backward
- rmail-mime-charset-pattern
- start t))))
- (intern (downcase (match-string 1))))))
- (rmail-decode-region start (point) mime-charset)))))
+ (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 rmail-enable-mime
+ (not rmail-enable-multibyte)
+ (let ((mime-charset
+ (if (and rmail-decode-mime-charset
+ (save-excursion
+ (goto-char start)
+ (search-forward "\n\n" nil t)
+ (let ((case-fold-search t))
+ (re-search-backward
+ rmail-mime-charset-pattern
+ start t))))
+ (intern (downcase (match-string 1))))))
+ (rmail-decode-region start (point) mime-charset))))
;; Add an X-Coding-System: header if we don't have one.
(save-excursion
(goto-char start)
(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 "_"
+ (while (search-forward "\n\^_" nil t) ; single char "\^_"
+ (replace-match "\n^_")))) ; 2 chars: "^" and "_"
(setq last-coding-system-used nil)
(or rmail-enable-mime
(not rmail-enable-multibyte)
(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 "_"
+ (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.
(while (and ignored-headers
(re-search-forward ignored-headers nil t))
(beginning-of-line)
- (if (looking-at rmail-nonignored-headers)
+ (if (and rmail-nonignored-headers
+ (looking-at rmail-nonignored-headers))
(forward-line 1)
(delete-region (point)
(save-excursion
(inhibit-read-only t)
;; Highlight with boldface if that is available.
;; Otherwise use the `highlight' face.
- (face (or rmail-highlight-face
+ (face (or 'rmail-highlight
(if (face-differs-from-default-p 'bold)
'bold 'highlight)))
;; List of overlays to reuse.
(setq subject (regexp-quote subject))
(setq subject
(replace-regexp-in-string "[ \t\n]+" "[ \t\n]+" subject t t))
- (concat "^Subject: "
+ ;; Some mailers insert extra spaces after "Subject:", so allow any
+ ;; amount of them.
+ (concat "^Subject:[ \t]+"
(if (string= "\\`" (substring rmail-reply-regexp 0 2))
(substring rmail-reply-regexp 2)
rmail-reply-regexp)
(provide 'rmail)
-;;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c
+;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c
;;; rmail.el ends here
HCoop / bpt / emacs.git / blobdiff