summaryrefslogtreecommitdiff
path: root/lisp/mail
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mail')
-rw-r--r--lisp/mail/blessmail.el1
-rw-r--r--lisp/mail/emacsbug.el11
-rw-r--r--lisp/mail/feedmail.el1
-rw-r--r--lisp/mail/footnote.el1
-rw-r--r--lisp/mail/mail-extr.el37
-rw-r--r--lisp/mail/mail-hist.el1
-rw-r--r--lisp/mail/mail-utils.el73
-rw-r--r--lisp/mail/mailabbrev.el16
-rw-r--r--lisp/mail/mailalias.el1
-rw-r--r--lisp/mail/mailheader.el1
-rw-r--r--lisp/mail/mailpost.el1
-rw-r--r--lisp/mail/metamail.el2
-rw-r--r--lisp/mail/mspools.el1
-rw-r--r--lisp/mail/reporter.el2
-rw-r--r--lisp/mail/rfc2368.el37
-rw-r--r--lisp/mail/rfc822.el25
-rw-r--r--lisp/mail/rmail-spam-filter.el548
-rw-r--r--lisp/mail/rmail.el10
-rw-r--r--lisp/mail/rmailedit.el1
-rw-r--r--lisp/mail/rmailkwd.el1
-rw-r--r--lisp/mail/rmailmsc.el1
-rw-r--r--lisp/mail/rmailout.el1
-rw-r--r--lisp/mail/rmailsort.el1
-rw-r--r--lisp/mail/rmailsum.el14
-rw-r--r--lisp/mail/sendmail.el33
-rw-r--r--lisp/mail/smtpmail.el171
-rw-r--r--lisp/mail/supercite.el1
-rw-r--r--lisp/mail/uce.el1
-rw-r--r--lisp/mail/undigest.el1
-rw-r--r--lisp/mail/unrmail.el1
-rw-r--r--lisp/mail/vms-pmail.el1
31 files changed, 514 insertions, 483 deletions
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index d87f1f3232d..70438811dcf 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -66,4 +66,5 @@
(write-region (point-min) (point-max) "blessmail")
(kill-emacs)
+;;; arch-tag: c3329fe2-f945-41a9-8b00-b4b038ff182f
;;; blessmail.el ends here
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index c86c1827261..e93f76c3042 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -79,6 +79,7 @@ Prompts for bug subject. Leaves you in a mail buffer."
;; If there are four numbers in emacs-version, this is a pretest
;; version.
(let ((pretest-p (string-match "\\..*\\..*\\." emacs-version))
+ (from-buffer (current-buffer))
user-point prompt-beg-point message-end-point)
(setq message-end-point
(with-current-buffer (get-buffer-create "*Messages*")
@@ -141,6 +142,15 @@ usually do not have translators to read other languages for them.\n\n")
(insert (format " default-enable-multibyte-characters: %s\n"
default-enable-multibyte-characters))
(insert "\n")
+ (insert (format "Major mode: %s\n"
+ (buffer-local-value 'mode-name from-buffer)))
+ (insert "\n")
+ (insert "Minor modes in effect:\n")
+ (dolist (mode minor-mode-list)
+ (and (boundp mode) (buffer-local-value mode from-buffer)
+ (insert (format " %s: %s\n" mode
+ (buffer-local-value mode from-buffer)))))
+ (insert "\n")
(insert "Recent input:\n")
(let ((before-keys (point)))
(insert (mapconcat (lambda (key)
@@ -255,4 +265,5 @@ and send the mail again using \\[mail-send-and-exit].")))
(provide 'emacsbug)
+;;; arch-tag: 248b6523-c3b5-4fec-9a3f-0411fafa7d49
;;; emacsbug.el ends here
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index 735bcd36353..3d1b1951421 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -2670,4 +2670,5 @@ been weeded out."
(provide 'feedmail)
+;;; arch-tag: ec27b380-11c0-4dfd-8436-f636cf2bb992
;;; feedmail.el ends here
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index b4e8d20c4ef..4644d36ad25 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -752,4 +752,5 @@ key binding
(provide 'footnote)
+;;; arch-tag: 9bcfb6d7-2161-4caf-8793-700f62400398
;;; footnote.el ends here
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 8bcc4c72d3a..faa7ca1bb74 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -231,6 +231,7 @@ we will assume that \"John Q. Smith\" is the fellow's name."
If true, then when we see an address like \"Idiot <dumb@stupid.com>\"
we will act as though we couldn't find a full name in the address."
:type 'boolean
+ :version "21.4"
:group 'mail-extr)
;; Matches a leading title that is not part of the name (does not
@@ -273,27 +274,6 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Constant definitions.
;;
-;; Codes in
-;; Names in ISO 8859-1 Name
-;; ISO 10XXX ISO 8859-2 in
-;; ISO 6937 ISO 10646 RFC Swedish
-;; etc. Hex Oct 1345 TeX Split ASCII Description
-;; --------- ---------- ---- --- ----- ----- -------------------------------
-;; %a E4 344 a: \"a ae { latin small a + diaeresis d
-;; %o F6 366 o: \"o oe | latin small o + diaeresis v
-;; @a E5 345 aa \oa aa } latin small a + ring above e
-;; %u FC 374 u: \"u ue ~ latin small u + diaeresis |
-;; /e E9 351 e' \'e ` latin small e + acute i
-;; %A C4 304 A: \"A AE [ latin capital a + diaeresis D
-;; %O D6 326 O: \"O OE \ latin capital o + diaeresis V
-;; @A C5 305 AA \oA AA ] latin capital a + ring above E
-;; %U DC 334 U: \"U UE ^ latin capital u + diaeresis \
-;; /E C9 311 E' \'E @ latin capital e + acute I
-
-;; NOTE: @a and @A are not in ISO 8859-2 (the codes mentioned above invoke
-;; /l and /L). Some of this data was retrieved from
-;; listserv@jhuvm.hcf.jhu.edu.
-
;; Any character that can occur in a name, not counting characters that
;; separate parts of a multipart name (hyphen and period).
;; Yes, there are weird people with digits in their names.
@@ -530,8 +510,6 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
(?\040 " ") ;SPC
(?! ?~ "w") ;printable characters
(?\177 "w") ;DEL
- (?\200 ?\377 "w") ;high-bit-on characters
- (?\240 " ") ;nobreakspace
(?\t " ")
(?\r " ")
(?\n " ")
@@ -614,6 +592,10 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Utility functions and macros.
;;
+;; Fixme: There are Latin-1 nbsp below. If such characters should be
+;; included, this is the wrong thing to do -- it should use syntax (or
+;; regexp char classes).
+
(defsubst mail-extr-skip-whitespace-forward ()
;; v19 fn skip-syntax-forward is more tasteful, but not byte-coded.
(skip-chars-forward " \t\n\r "))
@@ -1727,19 +1709,19 @@ consing a string.)"
(and (>= word-count 2)
(not lower-case-flag)
(or
- ;; A trailing 4-or-more letter lowercase words preceded by
+ ;; Trailing 4-or-more letter lowercase words preceded by
;; mixed case or uppercase words will be dropped.
- (looking-at "[a-z][a-z][a-z][a-z]+[ \t]*\\'")
+ (looking-at "[[:lower:]]\\{4,\\}[ \t]*\\'")
;; Drop a trailing word which is terminated with a period.
(eq ?. (char-after (1- name-end))))
(setq drop-this-word-if-trailing-flag t))
;; Set the flags that indicate whether we have seen a lowercase
;; word, a mixed case word, and an uppercase word.
- (if (re-search-forward "[a-z]" name-end t)
+ (if (re-search-forward "[[:lower:]]" name-end t)
(if (progn
(goto-char name-beg)
- (re-search-forward "[A-Z]" name-end t))
+ (re-search-forward "[[:upper:]]" name-end t))
(setq mixed-case-flag t)
(setq lower-case-flag t))
;; (setq upper-case-flag t)
@@ -2144,4 +2126,5 @@ consing a string.)"
(provide 'mail-extr)
+;;; arch-tag: 7785fade-1073-4ed6-b4f6-28db34a7982d
;;; mail-extr.el ends here
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index da27b726efa..ba66ca079fe 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -293,4 +293,5 @@ received mail."
(provide 'mail-hist)
+;;; arch-tag: 9ff9a07c-9dca-482d-ba87-54f42778559d
;;; mail-hist.el ends here
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index 42be6b57040..aecc87cf178 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -79,6 +79,7 @@ we add the wrapper characters =?ISO-8859-1?Q?....?=."
(concat result (substring string i))))))
(defun mail-unquote-printable-hexdigit (char)
+ (setq char (upcase char))
(if (>= char ?A)
(+ (- char ?A) 10)
(- char ?0)))
@@ -107,31 +108,48 @@ we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
(apply 'concat (nreverse (cons (substring string i) strings))))))
;;;###autoload
-(defun mail-unquote-printable-region (beg end &optional wrapper)
+(defun mail-unquote-printable-region (beg end &optional wrapper noerror
+ unibyte)
"Undo the \"quoted printable\" encoding in buffer from BEG to END.
If the optional argument WRAPPER is non-nil,
-we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=."
+we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=.
+If NOERROR is non-nil, return t if successful.
+If UNIBYTE is non-nil, insert converted characters as unibyte.
+That is useful if you are going to character code decoding afterward,
+as Rmail does."
(interactive "r\nP")
- (save-match-data
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (when (and wrapper
- (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?"))
- (delete-region (match-end 1) end)
- (delete-region (point) (match-beginning 1)))
- (while (re-search-forward "=\\(..\\|\n\\)" nil t)
- (goto-char (match-end 0))
- (replace-match
- (if (= (char-after (match-beginning 1)) ?\n)
- ""
- (make-string 1
- (+ (* 16 (mail-unquote-printable-hexdigit
- (char-after (match-beginning 1))))
- (mail-unquote-printable-hexdigit
- (char-after (1+ (match-beginning 1)))))))
- t t))))))
+ (let (failed)
+ (save-match-data
+ (save-excursion
+ (save-restriction
+ (narrow-to-region beg end)
+ (goto-char (point-min))
+ (when (and wrapper
+ (looking-at "\\`=\\?ISO-8859-1\\?Q\\?\\([^?]*\\)\\?"))
+ (delete-region (match-end 1) end)
+ (delete-region (point) (match-beginning 1)))
+ (while (re-search-forward "=\\(\\([0-9A-F][0-9A-F]\\)\\|[=\n]\\|..\\)" nil t)
+ (goto-char (match-end 0))
+ (cond ((= (char-after (match-beginning 1)) ?\n)
+ (replace-match ""))
+ ((= (char-after (match-beginning 1)) ?=)
+ (replace-match "="))
+ ((match-beginning 2)
+ (let ((char (+ (* 16 (mail-unquote-printable-hexdigit
+ (char-after (match-beginning 2))))
+ (mail-unquote-printable-hexdigit
+ (char-after (1+ (match-beginning 2)))))))
+ (if unibyte
+ (progn
+ (replace-match "")
+ ;; insert-char will insert this as unibyte,
+ (insert-char char 1))
+ (replace-match (make-string 1 char) t t))))
+ (noerror
+ (setq failed t))
+ (t
+ (error "Malformed MIME quoted-printable message"))))
+ (not failed))))))
(eval-when-compile (require 'rfc822))
@@ -216,9 +234,15 @@ the comma-separated list. The pruned list is returned."
"")
(if (and user-mail-address
(not (equal user-mail-address user-login-name)))
- (concat (regexp-quote user-mail-address) "\\|")
+ ;; Anchor the login name and email address so
+ ;; that we don't match substrings: if the
+ ;; login name is "foo", we shouldn't match
+ ;; "barfoo@baz.com".
+ (concat "\\`"
+ (regexp-quote user-mail-address)
+ "\\'\\|")
"")
- (concat (regexp-quote user-login-name) "\\>"))))
+ (concat "\\`" (regexp-quote user-login-name) "@"))))
;; Split up DESTINATIONS and match each element separately.
(let ((start-pos 0) (cur-pos 0)
(case-fold-search t))
@@ -346,4 +370,5 @@ If 4th arg LIST is non-nil, return a list of all such fields."
(provide 'mail-utils)
+;;; arch-tag: b24aec2f-fd65-4ceb-9e39-3cc2827036fd
;;; mail-utils.el ends here
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index b2edf777861..1b94f179f94 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -30,7 +30,7 @@
;; This file ensures that, when the point is in a To:, CC:, BCC:, or From:
;; field, word-abbrevs are defined for each of your mail aliases. These
;; aliases will be defined from your .mailrc file (or the file specified by
-;; the MAILRC environment variable) if it exists. Your mail aliases will
+;; `mail-personal-alias-file') if it exists. Your mail aliases will
;; expand any time you type a word-delimiter at the end of an abbreviation.
;;
;; What you see is what you get: if mailabbrev is in use when you type
@@ -161,12 +161,13 @@ no aliases, which is represented by this being a table with no entries.)")
"The modification time of your mail alias file when it was last examined.")
(defun mail-abbrevs-sync-aliases ()
- (if (file-exists-p mail-personal-alias-file)
- (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
- (if (not (equal mail-abbrev-modtime modtime))
- (progn
- (setq mail-abbrev-modtime modtime)
- (build-mail-abbrevs))))))
+ (when mail-personal-alias-file
+ (if (file-exists-p mail-personal-alias-file)
+ (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
+ (if (not (equal mail-abbrev-modtime modtime))
+ (progn
+ (setq mail-abbrev-modtime modtime)
+ (build-mail-abbrevs)))))))
;;;###autoload
(defun mail-abbrevs-setup ()
@@ -625,4 +626,5 @@ Don't use this command in Lisp programs!
(if mail-abbrevs-mode
(mail-abbrevs-enable))
+;;; arch-tag: 5aa2d901-73f8-4ad7-b73c-4802282ad2ff
;;; mailabbrev.el ends here
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index 6d0c2e12125..18f52e6434f 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -540,4 +540,5 @@ See `mail-directory-stream'."
(provide 'mailalias)
+;;; arch-tag: 1d6a0f87-eb34-4d45-8816-60c1b952cf46
;;; mailalias.el ends here
diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el
index 163b2ecd5ec..1eac0dfa3a3 100644
--- a/lisp/mail/mailheader.el
+++ b/lisp/mail/mailheader.el
@@ -191,4 +191,5 @@ A key of nil has as its value a list of defaulted headers to ignore."
(provide 'mailheader)
+;;; arch-tag: 6e7aa221-80b5-4b3d-b46f-fd66ab567be0
;;; mailheader.el ends here
diff --git a/lisp/mail/mailpost.el b/lisp/mail/mailpost.el
index f8198c9e97d..8d57de6ede7 100644
--- a/lisp/mail/mailpost.el
+++ b/lisp/mail/mailpost.el
@@ -105,4 +105,5 @@ site-init."
(provide 'mailpost)
+;;; arch-tag: 1f8ca085-60a6-4eac-8efb-69ffec2fa124
;;; mailpost.el ends here
diff --git a/lisp/mail/metamail.el b/lisp/mail/metamail.el
index 7cfc4312a79..1ecedf515f9 100644
--- a/lisp/mail/metamail.el
+++ b/lisp/mail/metamail.el
@@ -3,7 +3,6 @@
;; Copyright (C) 1993, 1996 Free Software Foundation, Inc.
;; Author: Masanobu UMEDA <umerin@mse.kyutech.ac.jp>
-;; Version: $Id: metamail.el,v 1.14 2000/11/12 00:22:02 fx Exp $
;; Keywords: mail, news, mime, multimedia
;; This file is part of GNU Emacs.
@@ -190,4 +189,5 @@ redisplayed as output is inserted."
(provide 'metamail)
+;;; arch-tag: 52c0cb6f-d800-4776-9789-f0275cb5490e
;;; metamail.el ends here
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 1f8651727ec..8dc165dcc5e 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -404,4 +404,5 @@ nil."
(provide 'mspools)
+;;; arch-tag: 8990b3ee-68c8-4892-98f1-51a735c8bac6
;;; mspools.el ends here
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index c1d5839babd..6e609a1f365 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -407,4 +407,6 @@ mail-sending package is used for editing and sending the message."
(provide 'reporter)
+
+;;; arch-tag: 33612ff4-fbbc-4be2-b183-560ce9e0199b
;;; reporter.el ends here
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
index 25456523657..07ea44cef04 100644
--- a/lisp/mail/rfc2368.el
+++ b/lisp/mail/rfc2368.el
@@ -76,39 +76,13 @@
(defconst rfc2368-mailto-query-index 4
"Describes the portion of the url after '?'.")
-;; for dealing w/ unhexifying strings, my preferred approach is to use
-;; a 'string-replace-match-using-function' which can perform a
-;; string-replace-match and compute the replacement text based on a
-;; passed function -- however, emacs doesn't seem to have such a
-;; function yet :-(
-
-;; for the moment a rip-off of url-unhex (w3/url.el)
-(defun rfc2368-unhexify-char (char)
- "Unhexify CHAR -- e.g. %20 -> <SPC>."
- (if (> char ?9)
- (if (>= char ?a)
- (+ 10 (- char ?a))
- (+ 10 (- char ?A)))
- (- char ?0)))
-
-;; for the moment a rip-off of url-unhex-string (w3/url.el) (slightly modified)
(defun rfc2368-unhexify-string (string)
"Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'."
- (let ((case-fold-search t)
- (result ""))
- (while (string-match "%[0-9a-f][0-9a-f]" string)
- (let* ((start (match-beginning 0))
- (hex-code (+ (* 16
- (rfc2368-unhexify-char (elt string (+ start 1))))
- (rfc2368-unhexify-char (elt string (+ start 2))))))
- (setq result (concat
- result (substring string 0 start)
- (char-to-string hex-code))
- string (substring string (match-end 0)))))
- ;; it seems clearer to do things this way than to just return:
- ;; (concat result string)
- (setq result (concat result string))
- result))
+ (replace-regexp-in-string "%[[:xdigit:]]\\{2\\}"
+ (lambda (match)
+ (string (string-to-number (substring match 1)
+ 16)))
+ string t t))
(defun rfc2368-parse-mailto-url (mailto-url)
"Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
@@ -162,4 +136,5 @@ calling this function."
(provide 'rfc2368)
+;;; arch-tag: ea804934-ad96-4f69-957b-857a76e4fd95
;;; rfc2368.el ends here
diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el
index 989f43cd5a5..1a5dfad67f8 100644
--- a/lisp/mail/rfc822.el
+++ b/lisp/mail/rfc822.el
@@ -30,11 +30,13 @@
;;; Code:
-;; uses address-start free, throws to address
+(defvar rfc822-address-start)
+
+;; uses rfc822-address-start free, throws to address
(defun rfc822-bad-address (reason)
(save-restriction
(insert "_^_")
- (narrow-to-region address-start
+ (narrow-to-region rfc822-address-start
(if (re-search-forward "[,;]" nil t)
(max (point-min) (1- (point)))
(point-max)))
@@ -52,7 +54,7 @@
": \"")
(goto-char (point-max)) (insert "\")"))
(rfc822-nuke-whitespace)
- (throw 'address (buffer-substring address-start (point))))
+ (throw 'address (buffer-substring rfc822-address-start (point))))
(defun rfc822-nuke-whitespace (&optional leave-space)
(let (ch)
@@ -179,7 +181,7 @@
;; domain-literal is "[" *(dtext | quoted-pair) "]"
;; dtext is "[^][\\n"
;; domain-ref is atom
- (let ((address-start (point))
+ (let ((rfc822-address-start (point))
(n 0))
(catch 'address
;; optimize common cases:
@@ -198,14 +200,14 @@
(or (bobp) (/= (preceding-char) ?\ ) (delete-char -1))
;; relying on the fact that rfc822-looking-at <char>
;; doesn't mung match-data
- (throw 'address (buffer-substring address-start (match-end 0)))))
- (goto-char address-start)
+ (throw 'address (buffer-substring rfc822-address-start (match-end 0)))))
+ (goto-char rfc822-address-start)
(while t
(cond ((and (= n 1) (rfc822-looking-at ?@))
;; local-part@domain
(rfc822-snarf-domain)
(throw 'address
- (buffer-substring address-start (point))))
+ (buffer-substring rfc822-address-start (point))))
((rfc822-looking-at ?:)
(cond ((not allow-groups)
(rfc822-bad-address "A group name may not appear here"))
@@ -261,7 +263,7 @@
(throw 'address nil))
((= n 1) ; allow "foo" (losing unix seems to do this)
(throw 'address
- (buffer-substring address-start (point))))
+ (buffer-substring rfc822-address-start (point))))
((> n 1)
(rfc822-bad-address "Missing comma between addresses or badly-formatted address"))
((or (eobp) (= (following-char) ?,))
@@ -289,12 +291,12 @@
(replace-match "\\1 " t))
(goto-char (point-min))
- (rfc822-nuke-whitespace)
(let ((list ())
tem
- address-start); this is for rfc822-bad-address
+ rfc822-address-start); this is for rfc822-bad-address
+ (rfc822-nuke-whitespace)
(while (not (eobp))
- (setq address-start (point))
+ (setq rfc822-address-start (point))
(setq tem
(catch 'address ; this is for rfc822-bad-address
(cond ((rfc822-looking-at ?\,)
@@ -316,4 +318,5 @@
(provide 'rfc822)
+;;; arch-tag: 5d388a24-e173-40fb-9b8e-85269de44b37
;;; rfc822.el ends here
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index 0ae87fe5179..43177b7c99b 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -3,7 +3,7 @@
;; Copyright (C) 2002
;; Free Software Foundation, Inc.
;; Keywords: email, spam, filter, rmail
-;; Author: Eli Tziperman <eli@beach.weizmann.ac.il>
+;; Author: Eli Tziperman <eli AT deas.harvard.edu>
;; This file is part of GNU Emacs.
@@ -41,7 +41,7 @@
;;; (*) turn on the variable rmail-use-spam-filter,
-;;; (*) specify in variable rmail-spam-definitions-alist what sender,
+;;; (*) specify in variable rsf-definitions-alist what sender,
;;; subject and contents make an email be considered spam.
;;; in addition, you may:
@@ -49,36 +49,47 @@
;;; (*) Block future mail with the subject or sender of a message
;;; while reading it in RMAIL: just click on the "Spam" item on the
;;; menubar, and add the subject or sender to the list of spam
-;;; definitions using the mouse and the appropriate menu item. Â  You
+;;; definitions using the mouse and the appropriate menu item. You
;;; need to later also save the list of spam definitions using the
;;; same menu item, or alternatively, see variable
-;;; `rmail-spam-filter-autosave-newly-added-spam-definitions'.
+;;; `rsf-autosave-newly-added-definitions'.
;;; (*) specify if blind-cc'ed mail (no "To:" header field) is to be
-;;; treated as spam (variable rmail-spam-no-blind-cc; Thanks to Ethan
+;;; treated as spam (variable rsf-no-blind-cc; Thanks to Ethan
;;; Brown <ethan@gso.saic.com> for this).
;;; (*) specify if rmail-spam-filter should ignore case of spam
-;;; definitions (variable rmail-spam-filter-ignore-case; Thanks to
+;;; definitions (variable rsf-ignore-case; Thanks to
;;; Ethan Brown <ethan@gso.saic.com> for the suggestion).
;;; (*) Specify a "white-list" of trusted senders. If any
-;;; rmail-spam-white-list string matches a substring of the "From"
+;;; rsf-white-list string matches a substring of the "From"
;;; header, the message is flagged as a valid, non-spam message (Ethan
;;; Brown <ethan@gso.saic.com>).
+;;; (*) rmail-spam-filter is best used with a general purpose spam
+;;; filter such as the procmail-based http://www.spambouncer.org/.
+;;; Spambouncer is set to only mark messages as spam/blocked/bulk/OK
+;;; via special headers, and these headers may then be defined in
+;;; rmail-spam-filter such that the spam is rejected by
+;;; rmail-spam-filter itself.
+
;;; (*) rmail spam filter also works with bbdb to prevent spam senders
;;; from entering into the .bbdb file. See variable
-;;; "rmail-spam-filter-auto-delete-spam-bbdb-entries". This is done
+;;; "rsf-auto-delete-spam-bbdb-entries". This is done
;;; in two ways: (a) bbdb is made not to auto-create entries for
;;; messages that are deleted by the rmail-spam-filter, (b) when a
;;; message is deleted in rmail, the user is offered to delete the
;;; sender's bbdb entry as well _if_ it was created at the same day.
(require 'rmail)
+(if (> emacs-major-version 20)
+ (require 'rmailsum)
+ (if (not (fboundp 'rmail-make-summary-line)) (load-library "rmailsum")))
-;; For find-if and other cool common lisp functions we may want to use. (EDB)
-(require 'cl)
+;; For find-if and other cool common lisp functions we may want to use.
+(eval-when-compile
+ (require 'cl))
(defgroup rmail-spam-filter nil
"Spam filter for RMAIL, the mail reader for Emacs."
@@ -86,41 +97,51 @@
(defcustom rmail-use-spam-filter nil
"*Non-nil to activate the rmail spam filter.
-Specify `rmail-spam-definitions-alist' to define what you consider spam
+Specify `rsf-definitions-alist' to define what you consider spam
emails."
:type 'boolean
:group 'rmail-spam-filter )
-(defcustom rmail-spam-file "~/XRMAIL-SPAM"
+(defcustom rsf-file "~/XRMAIL-SPAM"
"*Name of rmail file for optionally saving some of the spam.
Spam may be either just deleted, or saved in a separate spam file to
be looked at at a later time. Whether the spam is just deleted or
also saved in a separete spam file is specified for each definition of
-spam, as one of the fields of `rmail-spam-definitions-alist'"
+spam, as one of the fields of `rsf-definitions-alist'"
:type 'string
:group 'rmail-spam-filter )
-(defcustom rmail-spam-no-blind-cc nil
+(defcustom rsf-no-blind-cc nil
"*Non-nil to treat blind CC (no To: header) as spam."
:type 'boolean
:group 'rmail-spam-filter )
-(defcustom rmail-spam-filter-ignore-case nil
- "*Non-nil to ignore case in `rmail-spam-definitions-alist'."
+(defcustom rsf-ignore-case nil
+ "*Non-nil to ignore case in `rsf-definitions-alist'."
:type 'boolean
:group 'rmail-spam-filter )
-(defcustom rmail-spam-filter-beep nil
+(defcustom rsf-beep nil
"*Non-nil to beep if spam is found."
:type 'boolean
:group 'rmail-spam-filter )
-(defcustom rmail-spam-sleep-after-message 2.0
+(defcustom rsf-sleep-after-message 2.0
"*Seconds to wait after display of message that spam was found."
:type 'number
:group 'rmail-spam-filter )
-
-(defcustom rmail-spam-filter-auto-delete-spam-bbdb-entries nil
+
+(defcustom rsf-min-region-to-spam-list 7
+ "*User may highlight a region in an incomming message and use
+ the menubar to add this region to the spam definitions. This
+ variable specifies the minimum size of region that may be added
+ to spam list, to avoid accidentally adding a too short region
+ which would result in false positive identification of spam
+ messages."
+ :type 'integer
+ :group 'rmail-spam-filter )
+
+(defcustom rsf-auto-delete-spam-bbdb-entries nil
"*Non-nil to make sure no entries are made in bbdb for spam emails.
This is done in two ways: (1) bbdb is made not to auto-create entries
for messages that are deleted by the `rmail-spam-filter', (2) when a
@@ -131,7 +152,7 @@ take an effect."
:type 'boolean
:group 'rmail-spam-filter )
-(defcustom rmail-spam-filter-autosave-newly-added-spam-definitions nil
+(defcustom rsf-autosave-newly-added-definitions nil
"*Non-nil to auto save new spam entries.
New entries entered via the spam menu bar item are then saved to
customization file immediately after being added via the menu bar, and
@@ -140,17 +161,17 @@ entries."
:type 'boolean
:group 'rmail-spam-filter )
-(defcustom rmail-spam-white-list nil
+(defcustom rsf-white-list nil
"*List of strings to identify valid senders.
-If any rmail-spam-white-list string matches a substring of the 'From'
+If any rsf-white-list string matches a substring of the 'From'
header, the message is flagged as a valid, non-spam message. Example:
If your domain is emacs.com then including 'emacs.com' in your
-rmail-spam-white-list would flag all mail from your colleagues as
+rsf-white-list would flag all mail from your colleagues as
valid."
:type '(repeat string)
:group 'rmail-spam-filter )
-(defcustom rmail-spam-definitions-alist nil
+(defcustom rsf-definitions-alist nil
"*Alist matching strings defining what messages are considered spam.
Each definition may contain specifications of one or more of the
elements {subject, sender, recipients or contents}, as well as a
@@ -159,7 +180,9 @@ is defined as one that fits all of the specified elements of any one
of the spam definitions. The strings that specify spam subject,
sender, etc, may be regexp. For example, to specify that the subject
may be either 'this is spam' or 'another spam', use the regexp: 'this
-is spam\|another spam' (without the single quotes)."
+is spam\\|another spam' (without the single quotes). To specify that
+if the contents contain both this and that the message is spam,
+specify 'this\\&that' in the appropriate spam definition field."
:type '(repeat
(list :format "%v"
(cons :format "%v" :value (from . "")
@@ -171,6 +194,9 @@ is spam\|another spam' (without the single quotes)."
(cons :format "%v" :value (subject . "")
(const :format "" subject)
(string :tag "Subject" ""))
+ (cons :format "%v" :value (content-type . "")
+ (const :format "" content-type)
+ (string :tag "Content-Type" ""))
(cons :format "%v" :value (contents . "")
(const :format "" contents)
(string :tag "Contents" ""))
@@ -183,13 +209,38 @@ is spam\|another spam' (without the single quotes)."
))
:group 'rmail-spam-filter)
-(defvar rmail-spam-filter-scanning-messages-now nil
+(defvar rsf-scanning-messages-now nil
"Non nil when rmail-spam-filter scans messages,
-for interaction with `rmail-bbdb-auto-delete-spam-entries'")
+for interaction with `rsf-bbdb-auto-delete-spam-entries'")
+
+;; the advantage over the automatic filter definitions is the AND conjunction
+;; of in-one-definition-elements
+(defun check-field (field-symbol message-data definition result)
+ "Check if field-symbol is in `rsf-definitions-alist'.
+Capture maybe-spam and this-is-a-spam-email in a cons in result,
+where maybe-spam is in first and this-is-a-spam-email is in rest.
+The values are returned by destructively changing result.
+If FIELD-SYMBOL field does not exist AND is not specified,
+this may still be spam due to another element...
+if (first result) is nil, we already have a contradiction in another
+field"
+ (let ((definition-field (cdr (assoc field-symbol definition))))
+ (if (and (first result) (> (length definition-field) 0))
+ ;; only in this case can maybe-spam change from t to nil
+ ;; ... else, if FIELD-SYMBOL field does appear in the message,
+ ;; and it also appears in spam definition list, this
+ ;; is potentially a spam:
+ (if (and message-data
+ (string-match definition-field message-data))
+ ;; if we do not get a contradiction from another field, this is
+ ;; spam
+ (setf (rest result) t)
+ ;; the message data contradicts the specification, this is no spam
+ (setf (first result) nil)))))
(defun rmail-spam-filter (msg)
- "Return nil if msg is spam based on rmail-spam-definitions-alist.
-If spam, optionally output msg to a file `rmail-spam-file' and delete
+ "Return nil if msg is spam based on rsf-definitions-alist.
+If spam, optionally output msg to a file `rsf-file' and delete
it from rmail file. Called for each new message retrieved by
`rmail-get-new-mail'."
@@ -200,22 +251,23 @@ it from rmail file. Called for each new message retrieved by
(message-sender)
(message-recipients)
(message-subject)
+ (message-content-type)
(num-spam-definition-elements)
(num-element 0)
(exit-while-loop nil)
(saved-case-fold-search case-fold-search)
(save-current-msg)
- (rmail-spam-filter-saved-bbdb/mail_auto_create_p nil)
+ (rsf-saved-bbdb/mail_auto_create_p nil)
)
;; make sure bbdb does not create entries for messages while spam
;; filter is scanning the rmail file:
- (setq rmail-spam-filter-saved-bbdb/mail_auto_create_p 'bbdb/mail_auto_create_p)
+ (setq rsf-saved-bbdb/mail_auto_create_p 'bbdb/mail_auto_create_p)
(setq bbdb/mail_auto_create_p nil)
- ;; let `rmail-bbdb-auto-delete-spam-entries' know that rmail spam
+ ;; let `rsf-bbdb-auto-delete-spam-entries' know that rmail spam
;; filter is running, so that deletion of rmail messages should be
;; ignored for now:
- (setq rmail-spam-filter-scanning-messages-now t)
+ (setq rsf-scanning-messages-now t)
(save-excursion
(save-restriction
(setq this-is-a-spam-email nil)
@@ -225,166 +277,111 @@ it from rmail file. Called for each new message retrieved by
(goto-char (rmail-msgbeg msg))
(narrow-to-region (point) (progn (search-forward "\n\n") (point)))
(setq message-sender (mail-fetch-field "From"))
- (setq message-recipients (mail-fetch-field "To"))
+ (setq message-recipients
+ (concat (mail-fetch-field "To")
+ (if (mail-fetch-field "Cc")
+ (concat ", " (mail-fetch-field "Cc")))))
(setq message-subject (mail-fetch-field "Subject"))
+ (setq message-content-type (mail-fetch-field "Content-Type"))
)
;; Find number of spam-definition elements in the list
- ;; rmail-spam-definitions-alist specified by user:
+ ;; rsf-definitions-alist specified by user:
(setq num-spam-definition-elements (safe-length
- rmail-spam-definitions-alist))
+ rsf-definitions-alist))
;;; do we want to ignore case in spam definitions:
- (setq case-fold-search rmail-spam-filter-ignore-case)
+ (setq case-fold-search rsf-ignore-case)
;; Check for blind CC condition. Set vars such that while
- ;; loop will be bypassed and spam condition will trigger (EDB)
- (if (and rmail-spam-no-blind-cc
+ ;; loop will be bypassed and spam condition will trigger
+ (if (and rsf-no-blind-cc
(null message-recipients))
- (progn
- (setq exit-while-loop t)
- (setq maybe-spam t)
- (setq this-is-a-spam-email t)))
-
- ;; Check white list, and likewise cause while loop
- ;; bypass. (EDB)
- (if (find-if '(lambda (white-str)
- (string-match white-str message-sender))
- rmail-spam-white-list)
- (progn
- (setq exit-while-loop t)
- (setq maybe-spam nil)
- (setq this-is-a-spam-email nil)))
-
- ;; scan all elements of the list rmail-spam-definitions-alist
+ (setq exit-while-loop t
+ maybe-spam t
+ this-is-a-spam-email t))
+
+ ;; Check white list, and likewise cause while loop
+ ;; bypass.
+ (if (let ((white-list rsf-white-list)
+ (found nil))
+ (while (and (not found) white-list)
+ (if (string-match (car white-list) message-sender)
+ (setq found t)
+ (setq white-list (cdr white-list))))
+ found)
+ (setq exit-while-loop t
+ maybe-spam nil
+ this-is-a-spam-email nil))
+
+ ;; maybe-spam is in first, this-is-a-spam-email in rest, this
+ ;; simplifies the call to check-field
+ (setq maybe-spam (cons maybe-spam this-is-a-spam-email))
+
+ ;; scan all elements of the list rsf-definitions-alist
(while (and
(< num-element num-spam-definition-elements)
(not exit-while-loop))
- (progn
+ (let ((definition (nth num-element rsf-definitions-alist)))
;; Initialize maybe-spam which is set to t in one of two
;; cases: (1) unspecified definition-elements are found in
- ;; rmail-spam-definitions-alist, (2) empty field is found
+ ;; rsf-definitions-alist, (2) empty field is found
;; in the message being scanned (e.g. empty subject,
;; sender, recipients, etc). The variable is set to nil
;; if a non empty field of the scanned message does not
;; match a specified field in
- ;; rmail-spam-definitions-alist.
- (setq maybe-spam t)
+ ;; rsf-definitions-alist.
+
;; initialize this-is-a-spam-email to nil. This variable
;; is set to t if one of the spam definitions matches a
;; field in the scanned message.
- (setq this-is-a-spam-email nil)
+ (setq maybe-spam (cons t nil))
;; start scanning incoming message:
;;---------------------------------
- ;; if sender field is not specified in message being
+ ;; Maybe the different fields should also be done in a
+ ;; loop to make the whole thing more flexible
+ ;; if sender field is not specified in message being
;; scanned, AND if "from" field does not appear in spam
;; definitions for this element, this may still be spam
;; due to another element...
- (if (and (not message-sender)
- (string-match
- (cdr (assoc 'from (nth num-element
- rmail-spam-definitions-alist))) ""))
- (setq maybe-spam t)
- ;; ... else, if message-sender does appear in the
- ;; message, and it also appears in the spam definition
- ;; list, it is potentially spam:
- (if (and message-sender
- (string-match
- (cdr (assoc 'from (nth num-element
- rmail-spam-definitions-alist)))
- message-sender)
- )
- (setq this-is-a-spam-email t)
- (setq maybe-spam nil)
- )
- )
- ;; next, if spam was not ruled out already, check recipients:
- (if maybe-spam
- ;; if To field does not exist AND is not specified,
- ;; this may still be spam due to another element...
- (if (and (not message-recipients)
- (string-match
- (cdr (assoc 'to
- (nth num-element
- rmail-spam-definitions-alist))) ""))
- (setq maybe-spam t)
- ;; ... else, if To field does appear in the message,
- ;; and it also appears in spam definition list, this
- ;; is potentially a spam:
- (if (and message-recipients
- (string-match
- (cdr (assoc 'to (nth num-element
- rmail-spam-definitions-alist)))
- message-recipients)
- )
- (setq this-is-a-spam-email t)
- (setq maybe-spam nil)
- )
- )
- )
- ;; next, if spam was not ruled out already, check subject:
- (if maybe-spam
- ;; if subject field does not exist AND is not
- ;; specified, this may still be spam due to another
- ;; element...
- (if (and (not message-subject)
- (string-match
- (cdr (assoc 'subject
- (nth num-element
- rmail-spam-definitions-alist)))
- ""))
- (setq maybe-spam t)
- ;; ... else, if subject field does appear in the
- ;; message, and it also appears in the spam
- ;; definition list, this is potentially a spam:
- (if (and message-subject
- (string-match
- (cdr (assoc 'subject (nth num-element
- rmail-spam-definitions-alist)))
- message-subject)
- )
- (setq this-is-a-spam-email t)
- (setq maybe-spam nil)
- )
- )
- )
+ (check-field 'from message-sender definition maybe-spam)
+ ;; next, if spam was not ruled out already, check recipients:
+ (check-field 'to message-recipients definition maybe-spam)
+ ;; next, if spam was not ruled out already, check subject:
+ (check-field 'subject message-subject definition maybe-spam)
+ ;; next, if spam was not ruled out already, check content-type:
+ (check-field 'content-type message-content-type
+ definition maybe-spam)
;; next, if spam was not ruled out already, check
;; contents: if contents field is not specified, this may
;; still be spam due to another element...
- (if maybe-spam
- (if (string-match
- (cdr (assoc 'contents
- (nth num-element
- rmail-spam-definitions-alist))) "")
- (setq maybe-spam t)
- ;; ... else, check to see if it appears in spam
- ;; definition:
- (if (string-match
- (cdr (assoc 'contents
- (nth num-element
- rmail-spam-definitions-alist)))
- (buffer-substring
- (rmail-msgbeg msg) (rmail-msgend msg)))
- (setq this-is-a-spam-email t)
- (setq maybe-spam nil)))
- )
- ;; if the search in rmail-spam-definitions-alist found
+ (check-field 'contents
+ (buffer-substring
+ (rmail-msgbeg msg) (rmail-msgend msg))
+ definition maybe-spam)
+
+ ;; if the search in rsf-definitions-alist found
;; that this email is spam, output the email to the spam
;; rmail file, mark the email for deletion, leave the
;; while loop and return nil so that an rmail summary line
;; wont be displayed for this message:
- (if (and this-is-a-spam-email maybe-spam)
+ (if (and (first maybe-spam) (rest maybe-spam))
;; found that this is spam, no need to look at the
- ;; rest of the rmail-spam-definitions-alist, exit
+ ;; rest of the rsf-definitions-alist, exit
;; loop:
(setq exit-while-loop t)
;; else, spam was not yet found, increment number of
- ;; element in rmail-spam-definitions-alist and proceed
+ ;; element in rsf-definitions-alist and proceed
;; to next element:
(setq num-element (+ num-element 1)))
)
- )
+ )
+
+ ;; (BK) re-set originally used variables
+ (setq this-is-a-spam-email (rest maybe-spam)
+ maybe-spam (first maybe-spam))
+
(if (and this-is-a-spam-email maybe-spam)
(progn
;;(message "Found spam!")
@@ -394,39 +391,42 @@ it from rmail file. Called for each new message retrieved by
;; output and delete the spam msg if needed:
(setq save-current-msg rmail-current-message)
(setq rmail-current-message msg)
- ;; check action item and rmail-spam-definitions-alist
+ ;; check action item and rsf-definitions-alist
;; and do it:
(cond
((equal (cdr (assoc 'action
- (nth num-element rmail-spam-definitions-alist)))
+ (nth num-element rsf-definitions-alist)))
'output-and-delete)
(progn
- (rmail-output-to-rmail-file rmail-spam-file)
- (rmail-delete-message)
+ (rmail-output-to-rmail-file rsf-file 1 t)
+ ;; Don't delete if automatic deletion after output
+ ;; is turned on
+ (unless rmail-delete-after-output (rmail-delete-message))
))
((equal (cdr (assoc 'action
- (nth num-element rmail-spam-definitions-alist)))
+ (nth num-element rsf-definitions-alist)))
'delete-spam)
(progn
(rmail-delete-message)
))
)
(setq rmail-current-message save-current-msg)
- (setq bbdb/mail_auto_create_p 'rmail-spam-filter-saved-bbdb/mail_auto_create_p)
+ (setq bbdb/mail_auto_create_p
+ 'rsf-saved-bbdb/mail_auto_create_p)
;; set return value. These lines must be last in the
;; function, so that they will determine the value
;; returned by rmail-spam-filter:
(setq return-value nil))
(setq return-value t))))
(setq case-fold-search saved-case-fold-search)
- (setq rmail-spam-filter-scanning-messages-now nil)
+ (setq rsf-scanning-messages-now nil)
return-value))
;; define functions for interactively adding sender/subject of a
;; specific message to the spam definitions while reading it, using
;; the menubar:
-(defun rmail-spam-filter-add-subject-to-spam-list ()
+(defun rsf-add-subject-to-spam-list ()
(interactive)
(set-buffer rmail-buffer)
(let ((message-subject))
@@ -434,15 +434,16 @@ it from rmail file. Called for each new message retrieved by
;; note the use of a backquote and comma on the subject line here,
;; to make sure message-subject is actually evaluated and its value
;; substituted:
- (add-to-list 'rmail-spam-definitions-alist
+ (add-to-list 'rsf-definitions-alist
(list '(from . "")
'(to . "")
`(subject . ,message-subject)
+ '(content-type . "")
'(contents . "")
'(action . output-and-delete))
t)
- (customize-mark-to-save 'rmail-spam-definitions-alist)
- (if rmail-spam-filter-autosave-newly-added-spam-definitions
+ (customize-mark-to-save 'rsf-definitions-alist)
+ (if rsf-autosave-newly-added-definitions
(progn
(custom-save-all)
(message (concat "added subject \n <<< \n" message-subject
@@ -450,10 +451,11 @@ it from rmail file. Called for each new message retrieved by
"and saved the spam definitions to file.")))
(message (concat "added subject \n <<< \n" message-subject
" \n >>> \n to list of spam definitions. \n"
- "Don't forget to save the spam definitions to file using the spam menu"))
+ "Don't forget to save the spam definitions to file using the spam
+ menu"))
)))
-(defun rmail-spam-filter-add-sender-to-spam-list ()
+(defun rsf-add-sender-to-spam-list ()
(interactive)
(set-buffer rmail-buffer)
(let ((message-sender))
@@ -461,15 +463,16 @@ it from rmail file. Called for each new message retrieved by
;; note the use of a backquote and comma on the "from" line here,
;; to make sure message-sender is actually evaluated and its value
;; substituted:
- (add-to-list 'rmail-spam-definitions-alist
+ (add-to-list 'rsf-definitions-alist
(list `(from . ,message-sender)
'(to . "")
'(subject . "")
+ '(content-type . "")
'(contents . "")
'(action . output-and-delete))
t)
- (customize-mark-to-save 'rmail-spam-definitions-alist)
- (if rmail-spam-filter-autosave-newly-added-spam-definitions
+ (customize-mark-to-save 'rsf-definitions-alist)
+ (if rsf-autosave-newly-added-definitions
(progn
(custom-save-all)
(message (concat "added sender \n <<< \n" message-sender
@@ -477,13 +480,14 @@ it from rmail file. Called for each new message retrieved by
"and saved the spam definitions to file.")))
(message (concat "added sender \n <<< \n " message-sender
" \n >>> \n to list of spam definitions."
- "Don't forget to save the spam definitions to file using the spam menu"))
+ "Don't forget to save the spam definitions to file using the spam
+ menu"))
)))
-(defun rmail-spam-filter-add-region-to-spam-list ()
- "Add the region makred by user in the rmail buffer to the list of
- spam definitions as a contents field."
+(defun rsf-add-region-to-spam-list ()
+ "Add the region makred by user in the rmail buffer to spam list.
+Added to spam definitions as a contents field."
(interactive)
(set-buffer rmail-buffer)
(let ((region-to-spam-list))
@@ -491,41 +495,48 @@ it from rmail file. Called for each new message retrieved by
(if (not (and mark-active (not (= (region-beginning) (region-end)))))
;; if inactive, print error message:
(message "you need to first highlight some text in the rmail buffer")
- ;; if active, add to list of spam definisions:
- (progn
- (setq region-to-spam-list (buffer-substring (region-beginning) (region-end)))
- ;; note the use of a backquote and comma on the "from" line here,
- ;; to make sure message-sender is actually evaluated and its value
- ;; substituted:
- (add-to-list 'rmail-spam-definitions-alist
- (list '(from . "")
- '(to . "")
- '(subject . "")
- `(contents . ,region-to-spam-list)
- '(action . output-and-delete))
- t)
- (customize-mark-to-save 'rmail-spam-definitions-alist)
- (if rmail-spam-filter-autosave-newly-added-spam-definitions
- (progn
- (custom-save-all)
- (message (concat "added highlighted text \n <<< \n" region-to-spam-list
- " \n >>> \n to list of spam definitions. \n"
- "and saved the spam definitions to file.")))
- (message (concat "added highlighted text \n <<< \n " region-to-spam-list
- " \n >>> \n to list of spam definitions."
- "Don't forget to save the spam definitions to file using the spam menu"))
- )))))
-
-
-(defun rmail-spam-filter-customize-spam-definitions ()
+ (if (< (- (region-end) (region-beginning)) rsf-min-region-to-spam-list)
+ (message
+ (concat "highlighted region is too small; min length set by variable \n"
+ "rsf-min-region-to-spam-list"
+ " is " (number-to-string rsf-min-region-to-spam-list)))
+ ;; if region active and long enough, add to list of spam definisions:
+ (progn
+ (setq region-to-spam-list (buffer-substring (region-beginning) (region-end)))
+ ;; note the use of a backquote and comma on the "from" line here,
+ ;; to make sure message-sender is actually evaluated and its value
+ ;; substituted:
+ (add-to-list 'rsf-definitions-alist
+ (list '(from . "")
+ '(to . "")
+ '(subject . "")
+ '(content-type . "")
+ `(contents . ,region-to-spam-list)
+ '(action . output-and-delete))
+ t)
+ (customize-mark-to-save 'rsf-definitions-alist)
+ (if rsf-autosave-newly-added-definitions
+ (progn
+ (custom-save-all)
+ (message (concat "added highlighted text \n <<< \n" region-to-spam-list
+ " \n >>> \n to list of spam definitions. \n"
+ "and saved the spam definitions to file.")))
+ (message (concat "added highlighted text \n <<< \n " region-to-spam-list
+ " \n >>> \n to list of spam definitions."
+ "Don't forget to save the spam definitions to file using the
+ spam menu"))
+ ))))))
+
+
+(defun rsf-customize-spam-definitions ()
(interactive)
- (customize-variable (quote rmail-spam-definitions-alist)))
+ (customize-variable (quote rsf-definitions-alist)))
-(defun rmail-spam-filter-customize-group ()
+(defun rsf-customize-group ()
(interactive)
(customize-group (quote rmail-spam-filter)))
-(defun rmail-spam-custom-save-all ()
+(defun rsf-custom-save-all ()
(interactive)
(custom-save-all))
@@ -537,96 +548,89 @@ it from rmail file. Called for each new message retrieved by
(cons "Spam" (make-sparse-keymap "Spam")))
(define-key rmail-summary-mode-map [menu-bar spam customize-group]
- '("Browse customizations of rmail spam filter" . rmail-spam-filter-customize-group))
+ '("Browse customizations of rmail spam filter" . rsf-customize-group))
(define-key rmail-mode-map [menu-bar spam customize-group]
- '("Browse customizations of rmail spam filter" . rmail-spam-filter-customize-group))
-(define-key rmail-summary-mode-map "\C-cSg" 'rmail-spam-filter-customize-group)
-(define-key rmail-mode-map "\C-cSg" 'rmail-spam-filter-customize-group)
+ '("Browse customizations of rmail spam filter" . rsf-customize-group))
+(define-key rmail-summary-mode-map "\C-cSg" 'rsf-customize-group)
+(define-key rmail-mode-map "\C-cSg" 'rsf-customize-group)
(define-key rmail-summary-mode-map [menu-bar spam customize-spam-list]
- '("Customize list of spam definitions" . rmail-spam-filter-customize-spam-definitions))
+ '("Customize list of spam definitions" . rsf-customize-spam-definitions))
(define-key rmail-mode-map [menu-bar spam customize-spam-list]
- '("Customize list of spam definitions" . rmail-spam-filter-customize-spam-definitions))
-(define-key rmail-summary-mode-map "\C-cSd" 'rmail-spam-filter-customize-spam-definitions)
-(define-key rmail-mode-map "\C-cSd" 'rmail-spam-filter-customize-spam-definitions)
+ '("Customize list of spam definitions" . rsf-customize-spam-definitions))
+(define-key rmail-summary-mode-map "\C-cSd" 'rsf-customize-spam-definitions)
+(define-key rmail-mode-map "\C-cSd" 'rsf-customize-spam-definitions)
(define-key rmail-summary-mode-map [menu-bar spam lambda] '("----"))
(define-key rmail-mode-map [menu-bar spam lambda] '("----"))
(define-key rmail-summary-mode-map [menu-bar spam my-custom-save-all]
- '("save newly added spam definitions to customization file" . rmail-spam-custom-save-all))
+ '("save newly added spam definitions to customization file" . rsf-custom-save-all))
(define-key rmail-mode-map [menu-bar spam my-custom-save-all]
- '("save newly added spam definitions to customization file" . rmail-spam-custom-save-all))
-(define-key rmail-summary-mode-map "\C-cSa" 'rmail-spam-custom-save-all)
-(define-key rmail-mode-map "\C-cSa" 'rmail-spam-custom-save-all)
+ '("save newly added spam definitions to customization file" . rsf-custom-save-all))
+(define-key rmail-summary-mode-map "\C-cSa" 'rsf-custom-save-all)
+(define-key rmail-mode-map "\C-cSa" 'rsf-custom-save-all)
(define-key rmail-summary-mode-map [menu-bar spam add-region-to-spam-list]
- '("add region to spam list" . rmail-spam-filter-add-region-to-spam-list))
+ '("add region to spam list" . rsf-add-region-to-spam-list))
(define-key rmail-mode-map [menu-bar spam add-region-to-spam-list]
- '("add region to spam list" . rmail-spam-filter-add-region-to-spam-list))
-(define-key rmail-summary-mode-map "\C-cSn" 'rmail-spam-filter-add-region-to-spam-list)
-(define-key rmail-mode-map "\C-cSn" 'rmail-spam-filter-add-region-to-spam-list)
+ '("add region to spam list" . rsf-add-region-to-spam-list))
+(define-key rmail-summary-mode-map "\C-cSn" 'rsf-add-region-to-spam-list)
+(define-key rmail-mode-map "\C-cSn" 'rsf-add-region-to-spam-list)
(define-key rmail-summary-mode-map [menu-bar spam add-sender-to-spam-list]
- '("add sender to spam list" . rmail-spam-filter-add-sender-to-spam-list))
+ '("add sender to spam list" . rsf-add-sender-to-spam-list))
(define-key rmail-mode-map [menu-bar spam add-sender-to-spam-list]
- '("add sender to spam list" . rmail-spam-filter-add-sender-to-spam-list))
-(define-key rmail-summary-mode-map "\C-cSr" 'rmail-spam-filter-add-sender-to-spam-list)
-(define-key rmail-mode-map "\C-cSr" 'rmail-spam-filter-add-sender-to-spam-list)
+ '("add sender to spam list" . rsf-add-sender-to-spam-list))
+(define-key rmail-summary-mode-map "\C-cSr" 'rsf-add-sender-to-spam-list)
+(define-key rmail-mode-map "\C-cSr" 'rsf-add-sender-to-spam-list)
(define-key rmail-summary-mode-map [menu-bar spam add-subject-to-spam-list]
- '("add subject to spam list" . rmail-spam-filter-add-subject-to-spam-list))
+ '("add subject to spam list" . rsf-add-subject-to-spam-list))
(define-key rmail-mode-map [menu-bar spam add-subject-to-spam-list]
- '("add subject to spam list" . rmail-spam-filter-add-subject-to-spam-list))
-(define-key rmail-summary-mode-map "\C-cSt" 'rmail-spam-filter-add-subject-to-spam-list)
-(define-key rmail-mode-map "\C-cSt" 'rmail-spam-filter-add-subject-to-spam-list)
-
-
-(defun rmail-bbdb-auto-delete-spam-entries ()
- "When deleting a message in RMAIL, check to see if the bbdb entry
-was created today, and if it was, prompt to delete it too. This function
-needs to be called via the `rmail-delete-message-hook' like this:
-\(add-hook 'rmail-delete-message-hook 'rmail-bbdb-auto-delete-spam-entries)"
- (interactive)
- (require 'bbdb-hooks)
- (if (not rmail-spam-filter-scanning-messages-now)
- (if (get-buffer "*BBDB*")
- (save-excursion
- (set-buffer (get-buffer "*BBDB*"))
- (if (bbdb-current-record)
- (if (equal
- (format-time-string bbdb-time-internal-format (current-time))
- (bbdb-record-getprop (bbdb-current-record) 'creation-date))
- (bbdb-delete-current-record (bbdb-current-record))))))))
-
-(defun rmail-spam-filter-bbdb-dont-create-entries-for-spam ()
- "Make sure senderes of rmail messages marked as deleted are not added to bbdb.
-Need to add this as a hook like this:
-\(setq bbdb/mail-auto-create-p 'rmail-spam-filter-bbdb-dont-create-entries-for-spam)
-and this is also used in conjunction with rmail-bbdb-auto-delete-spam-entries.
-More doc: rmail-bbdb-auto-delete-spam-entries will delete newly created bbdb
-entries of mail that is deleted. However, if one scrolls back to the deleted
-messages, then the sender is again added to the bbdb. This function
-prevents this. Also, don't create entries for messages in the `rmail-spam-file'."
+ '("add subject to spam list" . rsf-add-subject-to-spam-list))
+(define-key rmail-summary-mode-map "\C-cSt" 'rsf-add-subject-to-spam-list)
+(define-key rmail-mode-map "\C-cSt" 'rsf-add-subject-to-spam-list)
+
+(defun rsf-add-content-type-field ()
+ "Maintain backward compatibility with previous versions of rmail-spam-filter.
+The most recent version of rmai-spam-filter checks the contents
+field of the incoming mail to see if it spam. The format of
+`rsf-definitions-alist' has therefore changed. This function
+checks to see if old format is used, and if it is, it converts
+`rsf-definitions-alist' to the new format. Invoked
+automatically, no user input is required."
(interactive)
- (not
- ;; don't create a bbdb entry if one of the following conditions is satisfied:
- (or
- ;; 1) looking at a deleted message:
- (rmail-message-deleted-p rmail-current-message)
- ;; 2) looking at messages in rmail-spam-file:
- (string-match
- (expand-file-name rmail-spam-file)
- (expand-file-name (buffer-file-name rmail-buffer)))
- )))
-
-;; activate bbdb-anti-spam measures:
-(if rmail-spam-filter-auto-delete-spam-bbdb-entries
- (progn
- (add-hook 'rmail-delete-message-hook 'rmail-bbdb-auto-delete-spam-entries)
- (setq bbdb/mail-auto-create-p 'rmail-spam-filter-bbdb-dont-create-entries-for-spam)
- ))
+ (if (and rsf-definitions-alist
+ (not (assoc 'content-type (car rsf-definitions-alist))))
+ (let ((result nil)
+ (current nil)
+ (definitions rsf-definitions-alist))
+ (while definitions
+ (setq current (car definitions))
+ (setq definitions (cdr definitions))
+ (setq result
+ (append result
+ (list
+ (list (assoc 'from current)
+ (assoc 'to current)
+ (assoc 'subject current)
+ (cons 'content-type "")
+ (assoc 'contents current)
+ (assoc 'action current))))))
+ (setq rsf-definitions-alist result)
+ (customize-mark-to-save 'rsf-definitions-alist)
+ (if rsf-autosave-newly-added-definitions
+ (progn
+ (custom-save-all)
+ (message (concat "converted spam definitions to new format\n"
+ "and saved the spam definitions to file.")))
+ (message (concat "converted spam definitions to new format\n"
+ "Don't forget to save the spam definitions to file using the
+ spam menu"))
+ ))))
(provide 'rmail-spam-filter)
-;;; rmail-spam-filter ends here
+;;; arch-tag: 03e1d45d-b72f-4dd7-8f04-e7fd78249746
+;;; rmail-spam-fitler ends here
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index d84c7ebf026..5ab38370e57 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -1733,7 +1733,7 @@ It returns t if it got any new messages."
(if quoted-printable-header-field-end
(save-excursion
(unless
- (mail-unquote-printable-region header-end (point) nil t)
+ (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.
@@ -1880,8 +1880,7 @@ It returns t if it got any new messages."
(if quoted-printable-header-field-end
(save-excursion
(unless
- (mail-unquote-printable-region header-end (point) nil t)
-
+ (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.
@@ -1917,7 +1916,10 @@ It returns t if it got any new messages."
(goto-char (point-min))
(while (search-forward "\n\^_" nil t); single char
(replace-match "\n^_")))); 2 chars: "^" and "_"
- (or (bolp) (newline)) ; in case we lost the final newline.
+ ;; This is for malformed messages that don't end in newline.
+ ;; There shouldn't be any, but some users say occasionally
+ ;; there are some.
+ (or (bolp) (newline))
(insert ?\^_)
(setq last-coding-system-used nil)
(or rmail-enable-mime
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index 3835070b341..a057c019b82 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -156,4 +156,5 @@ This functions runs the normal hook `rmail-edit-mode-hook'.
(provide 'rmailedit)
+;;; arch-tag: 93c22709-a14a-46c1-ab91-52c3f5a0ec12
;;; rmailedit.el ends here
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index 693fbc68428..6772817637f 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -271,4 +271,5 @@ With prefix argument N moves forward N messages with these labels."
(- (buffer-size) omax)))))
keyword))
+;;; arch-tag: b26b3392-99ca-4e1d-933a-dab59b04e9a8
;;; rmailkwd.el ends here
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index 7a0871f1414..ea0a9d0cf80 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -58,4 +58,5 @@ If FILE-NAME is empty, remove any existing inbox list."
(setq rmail-inbox-list (rmail-parse-file-inboxes))
(rmail-show-message rmail-current-message))
+;;; arch-tag: 74ed1d50-2c25-4cbd-b5ae-d29ed8aba6e4
;;; rmailmsc.el ends here
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index e23f73a9db2..0dd23d71d33 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -413,4 +413,5 @@ FILE-NAME defaults, interactively, from the Subject field of the message."
(if rmail-delete-after-output
(rmail-delete-forward)))
+;;; arch-tag: 447117c6-1a9a-4b88-aa43-3101b043e3a4
;;; rmailout.el ends here
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index c4e95c80541..3194358451c 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -246,4 +246,5 @@ Arguments are MSG and FIELD."
(provide 'rmailsort)
+;;; arch-tag: 0d90896b-0c35-46ac-b240-38be5ada2360
;;; rmailsort.el ends here
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index cb14d6a7c44..a49b47453d8 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -51,7 +51,7 @@
("^.....-.*" . font-lock-type-face) ; Unread.
;; Neither of the below will be highlighted if either of the above are:
("^.....[^D-] \\(......\\)" 1 font-lock-keyword-face) ; Date.
- ("{ \\([^\n}]+\\),}" 1 font-lock-comment-face)) ; Labels.
+ ("{ \\([^\n}]+\\) }" 1 font-lock-comment-face)) ; Labels.
"Additional expressions to highlight in Rmail Summary mode.")
;; Entry points for making a summary buffer.
@@ -300,8 +300,12 @@ By default, `identity' is set."
""
(concat "{"
(buffer-substring (point)
- (progn (end-of-line) (point)))
- "} ")))))
+ (progn (end-of-line)
+ (backward-char)
+ (if (looking-at ",")
+ (point)
+ (1+ (point)))))
+ " } ")))))
(line
(progn
(forward-line 1)
@@ -1070,7 +1074,8 @@ If SKIP-RMAIL, don't do anything to the Rmail buffer."
(if (< n 1)
(progn (message "No preceding message")
(setq n 1)))
- (if (> n total)
+ (if (and (> n total)
+ (> total 0))
(progn (message "No following message")
(goto-char (point-max))
(rmail-summary-goto-msg nil nowarn skip-rmail)))
@@ -1650,4 +1655,5 @@ KEYWORDS is a comma-separated list of labels."
(provide 'rmailsum)
+;;; arch-tag: 556079ee-75c1-47f5-9884-2e0a0bc6c5a1
;;; rmailsum.el ends here
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index 3d5d01c6586..9ef7e575bed 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -1,6 +1,6 @@
;;; sendmail.el --- mail sending commands for Emacs. -*- byte-compile-dynamic: t -*-
-;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 2003
+;; Copyright (C) 1985, 86, 92, 93, 94, 95, 96, 98, 2000, 2001, 2002, 03, 2004
;; Free Software Foundation, Inc.
;; Maintainer: FSF
@@ -68,11 +68,12 @@ controlled by a separate variable, `mail-specify-envelope-from'."
(defcustom mail-specify-envelope-from nil
"*If non-nil, specify the envelope-from address when sending mail.
The value used to specify it is whatever is found in
-`mail-envelope-from', with `user-mail-address' as fallback.
+the variable `mail-envelope-from', with `user-mail-address' as fallback.
On most systems, specifying the envelope-from address is a
-privileged operation. This variable is only used if
-`send-mail-function' is set to `sendmail-send-it'."
+privileged operation. This variable affects sendmail and
+smtpmail -- if you use feedmail to send mail, see instead the
+variable `feedmail-deduce-envelope-from'."
:version "21.1"
:type 'boolean
:group 'sendmail)
@@ -184,8 +185,8 @@ The function `mail-setup' runs this hook."
(defvar mail-aliases t
"Alist of mail address aliases,
or t meaning should be initialized from your mail aliases file.
-\(The file's name is normally `~/.mailrc', but your MAILRC environment
-variable can override that name.)
+\(The file's name is normally `~/.mailrc', but `mail-personal-alias-file'
+can specify a different file name.)
The alias definitions in the file have this form:
alias ALIAS MEANING")
@@ -386,10 +387,11 @@ actually occur.")
(defun sendmail-sync-aliases ()
- (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
- (or (equal mail-alias-modtime modtime)
- (setq mail-alias-modtime modtime
- mail-aliases t))))
+ (when mail-personal-alias-file
+ (let ((modtime (nth 5 (file-attributes mail-personal-alias-file))))
+ (or (equal mail-alias-modtime modtime)
+ (setq mail-alias-modtime modtime
+ mail-aliases t)))))
(defun mail-setup (to subject in-reply-to cc replybuffer actions)
(or mail-default-reply-to
@@ -398,8 +400,9 @@ actually occur.")
(if (eq mail-aliases t)
(progn
(setq mail-aliases nil)
- (if (file-exists-p mail-personal-alias-file)
- (build-mail-aliases))))
+ (when mail-personal-alias-file
+ (if (file-exists-p mail-personal-alias-file)
+ (build-mail-aliases)))))
;; Don't leave this around from a previous message.
(kill-local-variable 'buffer-file-coding-system)
;; This doesn't work for enable-multibyte-characters.
@@ -509,6 +512,9 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and
;; Allow using comment commands to add/remove quoting (this only does
;; anything if mail-yank-prefix is set to a non-nil value).
(set (make-local-variable 'comment-start) mail-yank-prefix)
+ (if mail-yank-prefix
+ (set (make-local-variable 'comment-start-skip)
+ (concat "^" (regexp-quote mail-yank-prefix) "[ \t]*")))
(make-local-variable 'adaptive-fill-regexp)
(setq adaptive-fill-regexp
(concat "[ \t]*[-[:alnum:]]+>+[ \t]*\\|"
@@ -1026,7 +1032,7 @@ external program defined by `sendmail-program'."
)
)
(exit-value (apply 'call-process-region args)))
- (or (null exit-value) (zerop exit-value)
+ (or (null exit-value) (eq 0 exit-value)
(error "Sending...failed with exit value %d" exit-value)))
(or fcc-was-found
(error "No recipients")))
@@ -1724,4 +1730,5 @@ you can move to one of them and type C-c C-c to recover that one."
(provide 'sendmail)
+;;; arch-tag: 48bc1025-d993-4d31-8d81-2a29491f0626
;;; sendmail.el ends here
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index e24f20b8691..60831b259d8 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -1,6 +1,7 @@
;;; smtpmail.el --- simple SMTP protocol (RFC 821) for sending mail
-;; Copyright (C) 1995, 1996, 2001, 2002, 2003 Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 2001, 2002, 2003, 2004
+;; Free Software Foundation, Inc.
;; Author: Tomoji Kagatani <kagatani@rbc.ncl.omron.co.jp>
;; Maintainer: Simon Josefsson <simon@josefsson.org>
@@ -44,6 +45,8 @@
;; '(("YOUR SMTP HOST" 25 "username" "password")))
;;(setq smtpmail-starttls-credentials
;; '(("YOUR SMTP HOST" 25 "~/.my_smtp_tls.key" "~/.my_smtp_tls.cert")))
+;; Where the 25 equals the value of `smtpmail-smtp-service', it can be an
+;; integer or a string, just as long as they match (eq).
;; To queue mail, set smtpmail-queue-mail to t and use
;; smtpmail-send-queued-mail to send.
@@ -212,7 +215,7 @@ This is relative to `smtpmail-queue-dir'.")
;;;
(defvar smtpmail-mail-address nil
- "Value of `user-mail-address' in ambient buffer.")
+ "Value to use for envelope-from address for mail from ambient buffer.")
;;;###autoload
(defun smtpmail-send-it ()
@@ -223,7 +226,11 @@ This is relative to `smtpmail-queue-dir'.")
(case-fold-search nil)
delimline
(mailbuf (current-buffer))
- (smtpmail-mail-address user-mail-address)
+ ;; Examine this variable now, so that
+ ;; local binding in the mail buffer will take effect.
+ (smtpmail-mail-address
+ (or (and mail-specify-envelope-from (mail-envelope-from))
+ user-mail-address))
(smtpmail-code-conv-from
(if enable-multibyte-characters
(let ((sendmail-coding-system smtpmail-code-conv-from))
@@ -399,11 +406,14 @@ This is relative to `smtpmail-queue-dir'.")
(with-temp-buffer
(let ((coding-system-for-read 'no-conversion))
(insert-file-contents file-msg))
- (if (not (null smtpmail-recipient-address-list))
- (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
- (current-buffer)))
- (error "Sending failed; SMTP protocol error"))
- (error "Sending failed; no recipients")))
+ (let ((smtpmail-mail-address
+ (or (and mail-specify-envelope-from (mail-envelope-from))
+ user-mail-address)))
+ (if (not (null smtpmail-recipient-address-list))
+ (if (not (smtpmail-via-smtp smtpmail-recipient-address-list
+ (current-buffer)))
+ (error "Sending failed; SMTP protocol error"))
+ (error "Sending failed; no recipients"))))
(delete-file file-msg)
(delete-file (concat file-msg ".el"))
(delete-region (point-at-bol) (point-at-bol 2)))
@@ -481,9 +491,9 @@ This is relative to `smtpmail-queue-dir'.")
(mech (car (smtpmail-intersection smtpmail-auth-supported mechs)))
(cred (if (stringp smtpmail-auth-credentials)
(let* ((netrc (netrc-parse smtpmail-auth-credentials))
- (hostentry (netrc-machine
- netrc host (format "%s" (or port "smtp"))
- "smtp")))
+ (port-name (format "%s" (or port "smtp")))
+ (hostentry (netrc-machine netrc host port-name
+ port-name)))
(when hostentry
(list host port
(netrc-get hostentry "login")
@@ -497,7 +507,7 @@ This is relative to `smtpmail-queue-dir'.")
(smtpmail-cred-server cred)
(smtpmail-cred-port cred))))))
ret)
- (when cred
+ (when (and cred mech)
(cond
((eq mech 'cram-md5)
(smtpmail-send-command process (format "AUTH %s" mech))
@@ -545,9 +555,12 @@ This is relative to `smtpmail-queue-dir'.")
(host (or smtpmail-smtp-server
(error "`smtpmail-smtp-server' not defined")))
(port smtpmail-smtp-service)
- (envelope-from (or (mail-envelope-from)
- smtpmail-mail-address
- user-mail-address))
+ ;; smtpmail-mail-address should be set to the appropriate
+ ;; buffer-local value by the caller, but in case not:
+ (envelope-from (or smtpmail-mail-address
+ (and mail-specify-envelope-from
+ (mail-envelope-from))
+ user-mail-address))
response-code
greeting
process-buffer
@@ -661,7 +674,7 @@ This is relative to `smtpmail-queue-dir'.")
(>= (car response-code) 400))
(throw 'done nil))))
- ;; MAIL FROM: <sender>
+ ;; MAIL FROM:<sender>
(let ((size-part
(if (or (member 'size supported-extensions)
(assoc 'size supported-extensions))
@@ -670,13 +683,8 @@ This is relative to `smtpmail-queue-dir'.")
;; size estimate:
(+ (- (point-max) (point-min))
;; Add one byte for each change-of-line
- ;; because or CR-LF representation:
- (count-lines (point-min) (point-max))
- ;; For some reason, an empty line is
- ;; added to the message. Maybe this
- ;; is a bug, but it can't hurt to add
- ;; those two bytes anyway:
- 2)))
+ ;; because of CR-LF representation:
+ (count-lines (point-min) (point-max)))))
""))
(body-part
(if (member '8bitmime supported-extensions)
@@ -696,8 +704,8 @@ This is relative to `smtpmail-queue-dir'.")
"")
"")))
; (smtpmail-send-command process (format "MAIL FROM:%s@%s" (user-login-name) (smtpmail-fqdn)))
- (smtpmail-send-command process (format "MAIL FROM: <%s>%s%s"
- envelope-from
+ (smtpmail-send-command process (format "MAIL FROM:<%s>%s%s"
+ envelope-from
size-part
body-part))
@@ -707,10 +715,10 @@ This is relative to `smtpmail-queue-dir'.")
(throw 'done nil)
))
- ;; RCPT TO: <recipient>
+ ;; RCPT TO:<recipient>
(let ((n 0))
(while (not (null (nth n recipient)))
- (smtpmail-send-command process (format "RCPT TO: <%s>" (smtpmail-maybe-append-domain (nth n recipient))))
+ (smtpmail-send-command process (format "RCPT TO:<%s>" (smtpmail-maybe-append-domain (nth n recipient))))
(setq n (1+ n))
(setq response-code (smtpmail-read-response process))
@@ -773,49 +781,49 @@ This is relative to `smtpmail-queue-dir'.")
(response-continue t)
(return-value '(nil ()))
match-end)
-
- (while response-continue
- (goto-char smtpmail-read-point)
- (while (not (search-forward "\r\n" nil t))
- (accept-process-output process)
- (goto-char smtpmail-read-point))
-
- (setq match-end (point))
- (setq response-strings
- (cons (buffer-substring smtpmail-read-point (- match-end 2))
- response-strings))
-
- (goto-char smtpmail-read-point)
- (if (looking-at "[0-9]+ ")
- (let ((begin (match-beginning 0))
- (end (match-end 0)))
- (if smtpmail-debug-info
- (message "%s" (car response-strings)))
-
- (setq smtpmail-read-point match-end)
-
- ;; ignore lines that start with "0"
- (if (looking-at "0[0-9]+ ")
- nil
+ (catch 'done
+ (while response-continue
+ (goto-char smtpmail-read-point)
+ (while (not (search-forward "\r\n" nil t))
+ (unless (memq (process-status process) '(open run))
+ (throw 'done nil))
+ (accept-process-output process)
+ (goto-char smtpmail-read-point))
+
+ (setq match-end (point))
+ (setq response-strings
+ (cons (buffer-substring smtpmail-read-point (- match-end 2))
+ response-strings))
+
+ (goto-char smtpmail-read-point)
+ (if (looking-at "[0-9]+ ")
+ (let ((begin (match-beginning 0))
+ (end (match-end 0)))
+ (if smtpmail-debug-info
+ (message "%s" (car response-strings)))
+
+ (setq smtpmail-read-point match-end)
+
+ ;; ignore lines that start with "0"
+ (if (looking-at "0[0-9]+ ")
+ nil
+ (setq response-continue nil)
+ (setq return-value
+ (cons (string-to-int
+ (buffer-substring begin end))
+ (nreverse response-strings)))))
+
+ (if (looking-at "[0-9]+-")
+ (progn (if smtpmail-debug-info
+ (message "%s" (car response-strings)))
+ (setq smtpmail-read-point match-end)
+ (setq response-continue t))
+ (progn
+ (setq smtpmail-read-point match-end)
(setq response-continue nil)
(setq return-value
- (cons (string-to-int
- (buffer-substring begin end))
- (nreverse response-strings)))))
-
- (if (looking-at "[0-9]+-")
- (progn (if smtpmail-debug-info
- (message "%s" (car response-strings)))
- (setq smtpmail-read-point match-end)
- (setq response-continue t))
- (progn
- (setq smtpmail-read-point match-end)
- (setq response-continue nil)
- (setq return-value
- (cons nil (nreverse response-strings)))
- )
- )))
- (setq smtpmail-read-point match-end)
+ (cons nil (nreverse response-strings)))))))
+ (setq smtpmail-read-point match-end))
return-value))
@@ -848,31 +856,15 @@ This is relative to `smtpmail-queue-dir'.")
)
(defun smtpmail-send-data (process buffer)
- (let
- ((data-continue t)
- (sending-data nil)
- this-line
- this-line-end)
-
+ (let ((data-continue t) sending-data)
(with-current-buffer buffer
(goto-char (point-min)))
-
(while data-continue
(with-current-buffer buffer
- (beginning-of-line)
- (setq this-line (point))
- (end-of-line)
- (setq this-line-end (point))
- (setq sending-data nil)
- (setq sending-data (buffer-substring this-line this-line-end))
- (if (/= (forward-line 1) 0)
- (setq data-continue nil)))
-
- (smtpmail-send-data-1 process sending-data)
- )
- )
- )
-
+ (setq sending-data (buffer-substring (point-at-bol) (point-at-eol)))
+ (end-of-line 2)
+ (setq data-continue (not (eobp))))
+ (smtpmail-send-data-1 process sending-data))))
(defun smtpmail-deduce-address-list (smtpmail-text-buffer header-start header-end)
"Get address list suitable for smtp RCPT TO: <address>."
@@ -950,4 +942,5 @@ many continuation lines."
(provide 'smtpmail)
+;;; arch-tag: a76992df-6d71-43b7-9e72-4bacc6c05466
;;; smtpmail.el ends here
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index 558b9f9e388..40c43af5823 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -2045,4 +2045,5 @@ more information. Info node `(SC)Top'."
(provide 'supercite)
(run-hooks 'sc-load-hook)
+;;; arch-tag: a5d5bfa6-3bd5-4414-8c65-0afc83e45cd3
;;; supercite.el ends here
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index 93b3e430e7a..08f76359abb 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -392,4 +392,5 @@ address, and postmaster of the mail relay used."
(provide 'uce)
+;;; arch-tag: 44b68c87-9b29-47bd-822c-3feee3883221
;;; uce.el ends here
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 1890353c33b..2c447065643 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -307,4 +307,5 @@ following the containing message."
(provide 'undigest)
+;;; arch-tag: 3a28b9fb-c1f5-43ef-9278-285f3e4b874d
;;; undigest.el ends here
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index f0e4bbf38bb..55f611b53ad 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -173,3 +173,4 @@ For example, invoke `emacs -batch -f batch-unrmail RMAIL'."
;;; unrmail.el ends here
+;;; arch-tag: 14c6290d-60b2-456f-8909-5c2387de6acb
diff --git a/lisp/mail/vms-pmail.el b/lisp/mail/vms-pmail.el
index 7fe7771d350..675d9112c7b 100644
--- a/lisp/mail/vms-pmail.el
+++ b/lisp/mail/vms-pmail.el
@@ -119,4 +119,5 @@ If neither file exists, fails quietly."
(provide 'vms-pmail)
+;;; arch-tag: 336850fc-7812-4663-8e4d-b9c13f47dce1
;;; vms-pmail.el ends here