;; 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:
(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
(unless (and coding-system
(coding-system-p coding-system))
(setq coding-system
- ;; Emacs 21.1 and later writes RMAIL files in emacs-mule, but
- ;; earlier versions did that with the current buffer's encoding.
- ;; So we want to favor detection of emacs-mule (whose normal
- ;; priority is quite low), but still allow detection of other
- ;; encodings if emacs-mule won't fit. The call to
- ;; detect-coding-with-priority below achieves that.
- (car (detect-coding-with-priority
- from to
- '((coding-category-emacs-mule . emacs-mule))))))
- (unless (memq coding-system
- '(undecided undecided-unix))
+ ;; If rmail-file-coding-system is nil, Emacs 21 writes
+ ;; RMAIL files in emacs-mule, Emacs 22 in utf-8, but
+ ;; earlier versions did that with the current buffer's
+ ;; encoding. So we want to favor detection of emacs-mule
+ ;; (whose normal priority is quite low) and utf-8, but
+ ;; still allow detection of other encodings if they won't
+ ;; fit. The call to with-coding-priority below achieves
+ ;; that.
+ (with-coding-priority '(emacs-mule utf-8)
+ (detect-coding-region from to 'highest))))
+ (unless (eq (coding-system-type coding-system) 'undecided)
(set-buffer-modified-p t) ; avoid locking when decoding
(let ((buffer-undo-list t))
(decode-coding-region from to coding-system))
;; 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.
(provide 'rmail)
-;;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c
+;; arch-tag: cff0a950-57fe-4f73-a86e-91ff75afd06c
;;; rmail.el ends here