summaryrefslogtreecommitdiff
path: root/lisp/mail
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mail')
-rw-r--r--lisp/mail/blessmail.el2
-rw-r--r--lisp/mail/emacsbug.el4
-rw-r--r--lisp/mail/feedmail.el16
-rw-r--r--lisp/mail/footnote.el22
-rw-r--r--lisp/mail/ietf-drums.el2
-rw-r--r--lisp/mail/mail-extr.el5
-rw-r--r--lisp/mail/mail-parse.el39
-rw-r--r--lisp/mail/mail-utils.el2
-rw-r--r--lisp/mail/mailabbrev.el12
-rw-r--r--lisp/mail/mailclient.el2
-rw-r--r--lisp/mail/mspools.el4
-rw-r--r--lisp/mail/reporter.el4
-rw-r--r--lisp/mail/rfc2047.el4
-rw-r--r--lisp/mail/rfc2231.el8
-rw-r--r--lisp/mail/rfc2368.el135
-rw-r--r--lisp/mail/rfc6068.el83
-rw-r--r--lisp/mail/rmail-spam-filter.el2
-rw-r--r--lisp/mail/rmail.el9
-rw-r--r--lisp/mail/rmailkwd.el11
-rw-r--r--lisp/mail/rmailmm.el2
-rw-r--r--lisp/mail/rmailout.el11
-rw-r--r--lisp/mail/rmailsum.el3
-rw-r--r--lisp/mail/sendmail.el26
-rw-r--r--lisp/mail/smtpmail.el24
-rw-r--r--lisp/mail/supercite.el2
-rw-r--r--lisp/mail/uce.el40
-rw-r--r--lisp/mail/undigest.el2
27 files changed, 263 insertions, 213 deletions
diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el
index f380f0df290..23fddfd1679 100644
--- a/lisp/mail/blessmail.el
+++ b/lisp/mail/blessmail.el
@@ -27,7 +27,7 @@
;; which (on systems that need it) is used during installation
;; to give appropriate permissions to movemail.
;;
-;; It has to be done from lisp in order to be sure of getting the
+;; It has to be done from Lisp in order to be sure of getting the
;; correct value of rmail-spool-directory.
;;; Code:
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 14c93f2fc8e..7c3f6ba5e6d 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -340,7 +340,7 @@ usually do not have translators for other languages.\n\n")))
(insert (format "\nFeatures:\n%s\n" features))
(fill-region (line-beginning-position 0) (point))
- (insert (format "\nMemory information:\n"))
+ (insert "\nMemory information:\n")
(pp (garbage-collect) (current-buffer))
;; This is so the user has to type something in order to send easily.
@@ -426,7 +426,7 @@ usually do not have translators for other languages.\n\n")))
(with-output-to-temp-buffer "*Bug Help*"
(princ (substitute-command-keys
(format "\
-You invoked the command M-x report-emacs-bug,
+You invoked the command \\[report-emacs-bug],
but you decided not to mail the bug report to the Emacs maintainers.
If you want to mail it to someone else instead,
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index cec573642ec..fe686cb6f86 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -7,7 +7,7 @@
;; Author: Bill Carpenter <bill@carpenter.ORG>
;; Version: 11
;; Keywords: email, queue, mail, sendmail, message, spray, smtp, draft
-;; X-URL: <URL:http://www.carpenter.org/feedmail/feedmail.html>
+;; URL: http://www.carpenter.org/feedmail/feedmail.html
;;; Commentary:
@@ -47,7 +47,7 @@
;; A NOTE TO THOSE WHO WOULD CHANGE THIS CODE... Since it is PD,
;; you're within your rights to do whatever you want. If you do
;; publish a new version with your changes in it, please (1) insert
-;; lisp comments describing the changes, (2) insert lisp comments
+;; Lisp comments describing the changes, (2) insert Lisp comments
;; that clearly delimit where your changes are, (3) email me a copy
;; (I can't always consistently follow the relevant usenet groups),
;; and (4) use a version number that is based on the version you're
@@ -128,7 +128,7 @@
;; --- you can generate/modify an X-Mailer: message header
;;
;; After a long list of options below, you will find the function
-;; feedmail-send-it. Hers's the best way to use the stuff in this
+;; feedmail-send-it. Hers's the best way to use the stuff in this
;; file:
;;
;; Save this file as feedmail.el somewhere on your elisp loadpath;
@@ -157,7 +157,7 @@
;; If you are wondering how to send your messages to some SMTP server
;; (which is not really a feedmail-specific issue), you are probably
;; looking for smtpmail.el, and it is probably already present in your
-;; emacs installation. Look at smtpmail.el for how to set that up, and
+;; Emacs installation. Look at smtpmail.el for how to set that up, and
;; then do this to hook it into feedmail:
;;
;; (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t)
@@ -939,7 +939,7 @@ a message you see a bit later.
There is a separate queue for draft messages, intended to prevent
you from accidentally sending incomplete messages. The queues are
disk-based and intended for later transmission. The messages are
-queued in their raw state as they appear in the mail-mode buffer and
+queued in their raw state as they appear in the `mail-mode' buffer and
can be arbitrarily edited later, before sending, by visiting the
appropriate file in the queue directory (and setting the buffer to
mail-mode or whatever). If you visit a file in the queue directory
@@ -1286,7 +1286,7 @@ of casual real use only to the feedmail developer."
"Duration of pause after feedmail-debug messages.
After some messages are divulged, it may be helpful to pause before
something else obliterates them. This value controls the duration of
-the pause. If the value is nil or 0, the sit-for is not done, which
+the pause. If the value is nil or 0, the `sit-for' is not done, which
has the effect of not pausing at all. Debug messages can be seen after
the fact in the messages buffer."
:version "24.1"
@@ -2020,7 +2020,7 @@ backup file names and the like)."
;; if can't find EOH, this is no message!
(unless (feedmail-find-eoh t)
(feedmail-say-chatter "Skipping %s; no mail-header-separator" maybe-file)
- (error "FQM: you should never see this message"))
+ (error "FQM: You should never see this message"))
(feedmail-say-debug "Prepping %s" maybe-file)
;; the catch is a way out for users to voluntarily skip sending a message
(catch 'skip-me-q (funcall feedmail-queue-runner-message-sender arg))
@@ -3149,7 +3149,7 @@ been weeded out."
(sit-for feedmail-queue-chatty-sit-for))))
(defun feedmail-find-eoh (&optional noerror)
- "Internal; finds the end of message header fields, returns mark just before it."
+ "Internal; find the end of message header fields, return mark just before it."
;; all this funny business with line endings is to account for CRLF
;; weirdness that I don't think I'll ever figure out
(feedmail-say-debug ">in-> feedmail-find-eoh %s" noerror)
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 995ae5f9160..716348a9c19 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -39,15 +39,15 @@
;; commands.
;; + more language styles.
;; + The key sequence 'C-c ! a C-y C-c ! b' should auto-fill the
-;; footnote in adaptive fill mode. This does not seem to be a bug in
+;; footnote in adaptive fill mode. This does not seem to be a bug in
;; `adaptive-fill' because it behaves that way on all point movements
;; + Handle footmode mode elegantly in all modes, even if that means refuses to
-;; accept the burden. For example, in a programming language mode, footnotes
+;; accept the burden. For example, in a programming language mode, footnotes
;; should be commented.
;; + Manually autofilling the a first footnote should not cause it to
;; wrap into the footnote section tag
;; + Current solution adds a second newline after the section tag, so it is
-;; clearly a separate paragraph. There may be stylistic objections to this.
+;; clearly a separate paragraph. There may be stylistic objections to this.
;; + Footnotes with multiple paragraphs should not have their first
;; line out-dented.
;; + Upon leaving footnote area, perform an auto-fill on an entire
@@ -55,7 +55,7 @@
;; + fill-paragraph takes arg REGION, but seemingly only when called
;; interactively.
;; + At some point, it became necessary to change `footnote-section-tag-regexp'
-;; to remove its trailing space. (Adaptive fill side-effect?)
+;; to remove its trailing space. (Adaptive fill side-effect?)
;; + useful for lazy testing
;; (setq footnote-narrow-to-footnotes-when-editing t)
;; (setq footnote-section-tag "Footnotes: ")
@@ -151,7 +151,7 @@ has no effect on buffers already displaying footnotes."
(defcustom footnote-align-to-fn-text t
"How to left-align footnote text.
If nil, footnote text is to be aligned flush left with left side
-of the footnote number. If non-nil, footnote text is to be aligned
+of the footnote number. If non-nil, footnote text is to be aligned
left with the first character of footnote text."
:type 'boolean)
@@ -243,7 +243,7 @@ Wrapping around the alphabet implies successive repetitions of letters."
"List of roman numerals with their values.")
(defconst footnote-roman-upper-regexp (upcase footnote-roman-lower-regexp)
- "Regexp of roman numerals. Not complete")
+ "Regexp of roman numerals. Not complete.")
(defun footnote--roman-upper (n)
"Generic Roman number footnoting."
@@ -380,8 +380,8 @@ Use Unicode characters for footnoting."
(concat "[" (apply #'concat footnote-hebrew-symbolic) "]"))
(defun footnote--hebrew-symbolic (n)
- "Only 22 elements, per the style of eg. 'פירוש שפתי חכמים על רש״י'.
-Proceeds from `י' to `כ', from `צ' to `ק'. After `ת', rolls over to `א'."
+ "Only 22 elements, per the style of e.g. 'פירוש שפתי חכמים על רש״י'.
+Proceeds from `י' to `כ', from `צ' to `ק'. After `ת', rolls over to `א'."
(nth (mod (1- n) 22) footnote-hebrew-symbolic))
;;; list of all footnote styles
@@ -679,7 +679,7 @@ instead, if applicable."
(defun footnote--get-area-point-max ()
"Return the end of footnote area.
This is either `point-max' or the start of a `.signature' string, as
-defined by variable `footnote-signature-separator'. If there is no
+defined by variable `footnote-signature-separator'. If there is no
footnote area, returns `point-max'."
(save-excursion (footnote--goto-char-point-max)))
@@ -713,7 +713,7 @@ Return the footnote number to use."
(save-excursion
(let (rc)
(dolist (alist-elem footnote--markers-alist)
- (when (<= (point) (cl-caddr alist-elem))
+ (when (<= (point) (caddr alist-elem))
(unless rc
(setq rc (car alist-elem)))
(save-excursion
@@ -835,7 +835,7 @@ being set it is automatically widened."
(when note
(when footnote-narrow-to-footnotes-when-editing
(widen))
- (goto-char (cl-caddr (assq note footnote--markers-alist)))
+ (goto-char (caddr (assq note footnote--markers-alist)))
(when (looking-at (footnote--current-regexp))
(goto-char (match-end 0))))))
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 2d683574743..b1682cf78a2 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -236,7 +236,7 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
(setq display-string (ietf-drums-get-comment string)))
(if (not mailbox)
(when (and display-string
- (string-match "@" display-string))
+ (string-search "@" display-string))
(cons
(mapconcat #'identity (nreverse display-name) "")
(ietf-drums-get-comment string)))
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 88fb0866856..24d8311f641 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -707,7 +707,10 @@ This function is primarily meant for when you're displaying the
result to the user: Many prettifications are applied to the
result returned. If you want to decode an address for further
non-display use, you should probably use
-`mail-header-parse-address' instead."
+`mail-header-parse-address' instead. Also see
+`mail-header-parse-address-lax' for a function that's less strict
+than `mail-header-parse-address', but does less post-processing
+to the results."
(let ((canonicalization-buffer (get-buffer-create " *canonical address*"))
(extraction-buffer (get-buffer-create " *extract address components*"))
value-list)
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index e72ed828494..212fadf3823 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -71,6 +71,45 @@
(defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region)
(defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string)
+(defun mail-header-parse-addresses-lax (string)
+ "Parse STRING as a comma-separated list of mail addresses.
+The return value is a list with mail/name pairs."
+ (delq nil
+ (mapcar (lambda (elem)
+ (or (mail-header-parse-address elem)
+ (mail-header-parse-address-lax elem)))
+ (mail-header-parse-addresses string t))))
+
+(defun mail-header-parse-address-lax (string)
+ "Parse STRING as a mail address.
+Returns a mail/name pair.
+
+This function will first try to parse STRING as a
+standards-compliant address string, and if that fails, try to use
+heuristics to determine the email address and the name in the
+string."
+ (with-temp-buffer
+ (insert (string-clean-whitespace string))
+ ;; Find the bit with the @ and guess that that's the mail.
+ (goto-char (point-max))
+ (when (search-backward "@" nil t)
+ (if (re-search-backward " " nil t)
+ (forward-char 1)
+ (goto-char (point-min)))
+ (let* ((start (point))
+ (mail (buffer-substring
+ start (or (re-search-forward " " nil t)
+ (goto-char (point-max))))))
+ (delete-region start (point))
+ ;; We've now removed the email bit, so the rest of the stuff
+ ;; has to be the name.
+ (cons (string-trim mail "[<]+" "[>]+")
+ (let ((name (string-trim (buffer-string)
+ "[ \t\n\r(]+" "[ \t\n\r)]+")))
+ (if (length= name 0)
+ nil
+ name)))))))
+
(provide 'mail-parse)
;;; mail-parse.el ends here
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index bb1f8f13bac..3eb3ccb93de 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -252,7 +252,7 @@ comma-separated list, and return the pruned list."
(setq cur-pos (string-match "[,\"]" destinations cur-pos))
(if (and cur-pos (equal (match-string 0 destinations) "\""))
;; Search for matching quote.
- (let ((next-pos (string-match "\"" destinations (1+ cur-pos))))
+ (let ((next-pos (string-search "\"" destinations (1+ cur-pos))))
(if next-pos
(setq cur-pos (1+ next-pos))
;; If the open-quote has no close-quote,
diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el
index 5cb4a7469a9..62d9b12bb26 100644
--- a/lisp/mail/mailabbrev.el
+++ b/lisp/mail/mailabbrev.el
@@ -76,10 +76,10 @@
;; should make sure your version does before including verbose addresses like
;; this. One solution to this, if you are on a system whose /bin/mail doesn't
;; work that way, (and you still want to be able to /bin/mail to send mail in
-;; addition to emacs) is to define minimal aliases (without full names) in
+;; addition to Emacs) is to define minimal aliases (without full names) in
;; your .mailrc file, and use define-mail-abbrev to redefine them when sending
-;; mail from emacs; this way, mail sent from /bin/mail will work, and mail
-;; sent from emacs will be pretty.
+;; mail from Emacs; this way, mail sent from /bin/mail will work, and mail
+;; sent from Emacs will be pretty.
;;
;; Aliases in the mailrc file may be nested. If you define aliases like
;; alias group1 fred ethel
@@ -98,7 +98,7 @@
;; normally cannot contain hyphens, but this code works around that for the
;; specific case of mail-alias word-abbrevs.
;;
-;; To read in the contents of another .mailrc-type file from emacs, use the
+;; To read in the contents of another .mailrc-type file from Emacs, use the
;; command Meta-X merge-mail-abbrevs. The rebuild-mail-abbrevs command is
;; similar, but will delete existing aliases first.
;;
@@ -363,7 +363,7 @@ double-quotes."
(defun mail-resolve-all-aliases-1 (sym &optional so-far)
(if (memq sym so-far)
- (error "mail alias loop detected: %s"
+ (error "Mail alias loop detected: %s"
(mapconcat #'symbol-name (cons sym so-far) " <- ")))
(let ((definition (and (boundp sym) (symbol-value sym))))
(if definition
@@ -388,7 +388,7 @@ double-quotes."
(defun mail-abbrev-expand-hook ()
"For use as the fourth arg to `define-abbrev'.
After expanding a mail-abbrev, if Auto Fill mode is on and we're past the
-fill-column, break the line at the previous comma, and indent the next line
+`fill-column', break the line at the previous comma, and indent the next line
with a space."
(when auto-fill-function
(let (p)
diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el
index 5c153ce1c1f..e6833806d92 100644
--- a/lisp/mail/mailclient.el
+++ b/lisp/mail/mailclient.el
@@ -198,7 +198,7 @@ The mail client is taken to be the handler of mailto URLs."
((string= character-coding "quoted-printable")
(mail-unquote-printable-region (point-min) (point-max)
nil nil t))
- (t (error "unsupported Content-Transfer-Encoding: %s"
+ (t (error "Unsupported Content-Transfer-Encoding: %s"
character-coding)))
(decode-coding-region (point-min) (point-max) coding-system))
(mailclient-encode-string-as-url
diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el
index 6d834140582..a36ccd98dcb 100644
--- a/lisp/mail/mspools.el
+++ b/lisp/mail/mspools.el
@@ -29,7 +29,7 @@
;; to be read in them. It assumes that new mail for the file `folder'
;; is written by the filter to a file called `folder.spool'. (If the
;; file writes directly to `folder' you may lose mail if new mail
-;; arrives whilst you are reading the folder in emacs, hence the use
+;; arrives whilst you are reading the folder in Emacs, hence the use
;; of a spool file.) For example, the following procmail recipe puts
;; any mail with `emacs' in the subject line into the spool file
;; `emacs.spool', ready to go into the folder `emacs'.
@@ -342,7 +342,7 @@ This is useful if `mspools-update' is nil."
(kill-buffer mspools-buffer))
(define-derived-mode mspools-mode special-mode "MSpools"
- "Major mode for output from mspools-show.
+ "Major mode for output from `mspools-show'.
\\<mspools-mode-map>Move point to one of the items in this buffer, then use
\\[mspools-visit-spool] to go to the spool that the current line refers to.
\\[revert-buffer] to regenerate the list of spools.
diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el
index 4b70582a261..2983a11d749 100644
--- a/lisp/mail/reporter.el
+++ b/lisp/mail/reporter.el
@@ -36,7 +36,7 @@
;; reporter.el was written primarily for Emacs Lisp package authors so
;; that their users can more easily report bugs. When invoked,
;; `reporter-submit-bug-report' will set up an outgoing mail buffer
-;; with the appropriate bug report address, including a lisp
+;; with the appropriate bug report address, including a Lisp
;; expression the maintainer of the package can evaluate to completely
;; reproduce the environment in which the bug was observed (e.g. by
;; using `eval-last-sexp'). This package proved especially useful
@@ -158,7 +158,7 @@ composed.")
(error indent-enclosing-p))))
(defun reporter-lisp-indent (_indent-point state)
- "A better lisp indentation style for bug reporting."
+ "A better Lisp indentation style for bug reporting."
(save-excursion
(goto-char (1+ (nth 1 state)))
(current-column)))
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index 5b08713949f..c442913d282 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -612,7 +612,7 @@ should not change this value.")
(setq next prev
prev nil)
(if (or (< index limit)
- (<= (+ len (or (string-match "\n" tail)
+ (<= (+ len (or (string-search "\n" tail)
(length tail)))
rfc2047-encode-max-chars))
(setq prev next
@@ -1111,7 +1111,7 @@ strings are stripped."
"Decode MIME-encoded STRING and return the result.
If ADDRESS-MIME is non-nil, strip backslashes which precede characters
other than `\"' and `\\' in quoted strings."
- (if (string-match "=\\?" string)
+ (if (string-search "=?" string)
(with-temp-buffer
;; We used to only call mm-enable-multibyte if `m' is non-nil,
;; but this can't be the right criterion. Don't just revert this
diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el
index 6fb4502b23b..a398ce0e9cc 100644
--- a/lisp/mail/rfc2231.el
+++ b/lisp/mail/rfc2231.el
@@ -61,12 +61,12 @@ must never cause a Lisp error."
;; make it parsable. Let's try...
(error
(let (mod)
- (when (and (string-match "\\\\\"" string)
+ (when (and (string-search "\\\"" string)
(not (string-match "\\`\"\\|[^\\]\"" string)))
- (setq string (replace-regexp-in-string "\\\\\"" "\"" string)
+ (setq string (string-replace "\\\"" "\"" string)
mod t))
- (when (and (string-match "\\\\(" string)
- (string-match "\\\\)" string)
+ (when (and (string-search "\\(" string)
+ (string-search "\\)" string)
(not (string-match "\\`(\\|[^\\][()]" string)))
(setq string (replace-regexp-in-string
"\\\\\\([()]\\)" "\\1" string)
diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el
deleted file mode 100644
index 553f3cc3a54..00000000000
--- a/lisp/mail/rfc2368.el
+++ /dev/null
@@ -1,135 +0,0 @@
-;;; rfc2368.el --- support for rfc2368 -*- lexical-binding:t -*-
-
-;; Copyright (C) 1998, 2000-2021 Free Software Foundation, Inc.
-
-;; Author: Sen Nagata <sen@eccosys.com>
-;; Keywords: mail
-
-;; This file is part of GNU Emacs.
-
-;; 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 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
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
-;; GNU General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; notes:
-;;
-;; -repeat after me: "the colon is not part of the header name..."
-;; -if w3 becomes part of emacs, then it may make sense to have this
-;; file depend on w3 -- the maintainer of w3 says merging w/ Emacs
-;; is planned!
-;;
-;; historical note:
-;;
-;; this is intended as a replacement for mailto.el
-;;
-;; acknowledgments:
-;;
-;; the functions that deal w/ unhexifying in this file were basically
-;; taken from w3 -- i hope to replace them w/ something else soon OR
-;; perhaps if w3 becomes a part of emacs soon, use the functions from w3.
-
-;;; History:
-;;
-;; 0.3:
-;;
-;; added the constant rfc2368-version
-;; implemented first potential fix for a bug in rfc2368-mailto-regexp
-;; implemented first potential fix for a bug in rfc2368-parse-mailto
-;; (both bugs reported by Kenichi OKADA)
-;;
-;; 0.2:
-;;
-;; started to use checkdoc
-;;
-;; 0.1:
-;;
-;; initial implementation
-
-;;; Code:
-
-;; only an approximation?
-;; see rfc 1738
-(defconst rfc2368-mailto-regexp
- "^\\(mailto:\\)\\([^?]+\\)?\\(\\?\\(.*\\)\\)*"
- "Regular expression to match and aid in parsing a mailto url.")
-
-;; describes 'mailto:'
-(defconst rfc2368-mailto-scheme-index 1
- "Describes the `mailto:' portion of the url.")
-;; i'm going to call this part the 'prequery'
-(defconst rfc2368-mailto-prequery-index 2
- "Describes the portion of the url between `mailto:' and `?'.")
-;; i'm going to call this part the 'query'
-(defconst rfc2368-mailto-query-index 4
- "Describes the portion of the url after `?'.")
-
-(defun rfc2368-unhexify-string (string)
- "Unhexify STRING -- e.g. `hello%20there' -> `hello there'."
- (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.
-MAILTO-URL should be a RFC 2368 (mailto) compliant url. A cons cell w/ a
-key of `Body' is a special case and is considered a header for this purpose.
-The returned alist is intended for use w/ the `compose-mail' interface.
-Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., &amp; -> &), before
-calling this function."
- (let ((case-fold-search t)
- prequery query headers-alist)
- (setq mailto-url (replace-regexp-in-string "\n" " " mailto-url))
- (if (string-match rfc2368-mailto-regexp mailto-url)
- (progn
- (setq prequery
- (match-string rfc2368-mailto-prequery-index mailto-url))
- (setq query
- (match-string rfc2368-mailto-query-index mailto-url))
-
- ;; build alist of header name-value pairs
- (if (not (null query))
- (setq headers-alist
- (mapcar
- (lambda (x)
- (let* ((temp-list (split-string x "="))
- (header-name (car temp-list))
- (header-value (cadr temp-list)))
- ;; return ("Header-Name" . "header-value")
- (cons
- (capitalize (rfc2368-unhexify-string header-name))
- (rfc2368-unhexify-string header-value))))
- (split-string query "&"))))
-
- ;; deal w/ multiple 'To' recipients
- (if prequery
- (progn
- (setq prequery (rfc2368-unhexify-string prequery))
- (if (assoc "To" headers-alist)
- (let* ((our-cons-cell
- (assoc "To" headers-alist))
- (our-cdr
- (cdr our-cons-cell)))
- (setcdr our-cons-cell (concat prequery ", " our-cdr)))
- (setq headers-alist
- (cons (cons "To" prequery) headers-alist)))))
-
- headers-alist)
-
- (error "Failed to match a mailto: url"))))
-
-(provide 'rfc2368)
-
-;;; rfc2368.el ends here
diff --git a/lisp/mail/rfc6068.el b/lisp/mail/rfc6068.el
new file mode 100644
index 00000000000..34fd7b5df4e
--- /dev/null
+++ b/lisp/mail/rfc6068.el
@@ -0,0 +1,83 @@
+;;; rfc6068.el --- support for rfc6068 -*- lexical-binding: t -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; Keywords: mail
+
+;; This file is part of GNU Emacs.
+
+;; 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 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
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;; Code:
+
+(defun rfc6068-unhexify-string (string &optional inhibit-decode)
+ "Unhexify STRING -- e.g. `hello%20there' -> `hello there'.
+STRING is assumed to be a percentage-encoded utf-8 string.
+
+If INHIBIT-DECODE is non-nil, return the resulting raw byte
+string instead of decoding as utf-8."
+ (let ((string
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ (insert string)
+ (goto-char (point-min))
+ (while (re-search-forward "%\\([[:xdigit:]]\\{2\\}\\)" nil t)
+ (replace-match (string (string-to-number (match-string 1) 16))
+ t t))
+ (buffer-string))))
+ (if inhibit-decode
+ string
+ (decode-coding-string string 'utf-8))))
+
+(defun rfc6068-parse-mailto-url (mailto-url)
+ "Parse MAILTO-URL, and return an alist of header-name, header-value pairs.
+MAILTO-URL should be a RFC 6068 (mailto) compliant url. A cons cell w/ a
+key of `Body' is a special case and is considered a header for this purpose.
+The returned alist is intended for use w/ the `compose-mail' interface.
+Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., &amp; -> &), before
+calling this function."
+ (let ((case-fold-search t)
+ headers-alist)
+ (setq mailto-url (string-replace "\n" " " mailto-url))
+ (when (string-match "^\\(mailto:\\)\\([^?]+\\)?\\(\\?\\(.*\\)\\)*"
+ mailto-url)
+ (let ((address (match-string 2 mailto-url))
+ (query (match-string 4 mailto-url)))
+ ;; Build alist of header name-value pairs.
+ (when query
+ (setq headers-alist
+ (mapcar
+ (lambda (x)
+ (let* ((pair (split-string x "="))
+ (name (car pair))
+ (value (cadr pair)))
+ ;; Return ("Header-Name" . "header-value").
+ (cons
+ (capitalize (rfc6068-unhexify-string name))
+ (rfc6068-unhexify-string value))))
+ (split-string query "&"))))
+
+ (when address
+ (setq address (rfc6068-unhexify-string address))
+ ;; Deal with multiple 'To' recipients.
+ (if-let ((elem (assoc "To" headers-alist)))
+ (setcdr elem (concat address ", " (cdr elem)))
+ (push (cons "To" address) headers-alist)))
+
+ headers-alist))))
+
+(provide 'rfc6068)
+
+;;; rfc6068.el ends here
diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el
index fbac9e0cc0c..75a6c723695 100644
--- a/lisp/mail/rmail-spam-filter.el
+++ b/lisp/mail/rmail-spam-filter.el
@@ -72,6 +72,8 @@
;;; rmail-spam-filter such that the spam is rejected by
;;; rmail-spam-filter itself.
+;;; Code:
+
(require 'rmail)
(require 'rmailsum)
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index e479a8e9b4a..9fbc9ba180f 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -207,8 +207,7 @@ or `-k' to enable Kerberos authentication."
(defvar rmail-remote-password-error "invalid usercode or password\\|
unknown user name or bad password\\|Authentication failed\\|MU_ERR_AUTH_FAILURE"
- "Regular expression matching incorrect-password POP or IMAP server error
-messages.
+ "Regexp matching incorrect-password POP or IMAP server error messages.
If you get an incorrect-password error that this expression does not match,
please report it with \\[report-emacs-bug].")
@@ -1960,7 +1959,7 @@ Value is the size of the newly read mail after conversion."
(file-name-nondirectory
(if (memq system-type '(windows-nt cygwin ms-dos))
;; cannot have colons in file name
- (replace-regexp-in-string ":" "-" file)
+ (string-replace ":" "-" file)
file)))
;; Use the directory of this rmail file
;; because it's a nuisance to use the homedir
@@ -3374,7 +3373,7 @@ The idea is to match it against simplified subjects of other messages."
;; Hide commas so it will work ok if parsed as a comma-separated list
;; of regexps.
(setq subject
- (replace-regexp-in-string "," "\054" subject t t))
+ (string-replace "," "\054" subject))
(concat "\\`" subject "\\'")))
(defun rmail-next-same-subject (n)
@@ -4483,7 +4482,7 @@ TEXT and INDENT are not used."
(defun rmail-get-remote-password (imap user host)
"Get the password for retrieving mail from a POP or IMAP server.
-If none has been set, the password is found via auth-source. If
+If none has been set, the password is found via auth-source. If
you use ~/.authinfo as your auth-source backend, then put
something like the following in that file:
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index acbb5880b5c..d8fcc1c0a99 100644
--- a/lisp/mail/rmailkwd.el
+++ b/lisp/mail/rmailkwd.el
@@ -74,12 +74,9 @@ according to the choice made, and returns a symbol."
(rmail-summary-exists)
(and (setq old (rmail-get-keywords))
(mapc #'rmail-make-label (split-string old ", "))))
- (completing-read (concat prompt
- (if rmail-last-label
- (concat " (default "
- (symbol-name rmail-last-label)
- "): ")
- ": "))
+ (completing-read (format-prompt prompt
+ (and rmail-last-label
+ (symbol-name rmail-last-label)))
rmail-label-obarray
nil
nil))))
@@ -93,7 +90,7 @@ according to the choice made, and returns a symbol."
"Set LABEL as present or absent according to STATE in message MSG.
LABEL may be a symbol or string."
(or (stringp label) (setq label (symbol-name label)))
- (if (string-match "," label)
+ (if (string-search "," label)
(error "More than one label specified"))
(with-current-buffer rmail-buffer
(rmail-maybe-set-message-counters)
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 99bff66657b..66a1e9a4dbd 100644
--- a/lisp/mail/rmailmm.el
+++ b/lisp/mail/rmailmm.el
@@ -254,7 +254,7 @@ TRUNCATED is non-nil if the text of this entity was truncated."))
(unless (y-or-n-p "This entity is truncated; save anyway? ")
(error "Aborted")))
(setq filename (expand-file-name
- (read-file-name (format "Save as (default: %s): " filename)
+ (read-file-name (format-prompt "Save as" filename)
directory
(expand-file-name filename directory))
directory))
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index eb8590f1f73..1f5bb2d9f1b 100644
--- a/lisp/mail/rmailout.el
+++ b/lisp/mail/rmailout.el
@@ -107,9 +107,8 @@ error: %S\n"
(read-file
(expand-file-name
(read-file-name
- (concat "Output message to mail file (default "
- (file-name-nondirectory default-file)
- "): ")
+ (format-prompt "Output message to mail file"
+ (file-name-nondirectory default-file))
(file-name-directory default-file)
(abbreviate-file-name default-file))
(file-name-directory default-file))))
@@ -434,7 +433,7 @@ AS-SEEN is non-nil if we are copying the message \"as seen\"."
(defun rmail-output-to-rmail-buffer (tembuf msg)
"Copy message in TEMBUF into the current Rmail buffer.
-Do what is necessary to make Rmail know about the new message. then
+Do what is necessary to make Rmail know about the new message, then
display message number MSG."
(save-excursion
(rmail-swap-buffers-maybe)
@@ -678,9 +677,9 @@ than appending to it. Deletes the message after writing if
(or (mail-fetch-field "Subject")
rmail-default-body-file)))
(setq default-file
- (replace-regexp-in-string ":" "-" default-file))
+ (string-replace ":" "-" default-file))
(setq default-file
- (replace-regexp-in-string " " "-" default-file))
+ (string-replace " " "-" default-file))
(list (setq rmail-default-body-file
(read-file-name
"Output message body to file: "
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 44cff21b062..9dd9573a9fc 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -758,7 +758,8 @@ the message being processed."
len mch lo newline)
;; If there are multiple lines in FROM,
;; discard up to the last newline in it.
- (while (setq newline (string-match "\n" from))
+ (while (and (stringp from)
+ (setq newline (string-search "\n" from)))
(setq from (substring from (1+ newline))))
(if (or (null from)
(string-match
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index fee11c06aa7..d0aff093dfe 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -277,6 +277,7 @@ The default value matches citations like `foo-bar>' plus whitespace."
(define-key map "\C-c\C-f\C-r" 'mail-reply-to)
(define-key map "\C-c\C-f\C-a" 'mail-mail-reply-to) ; author
(define-key map "\C-c\C-f\C-l" 'mail-mail-followup-to) ; list
+ (define-key map "\C-c\C-f\C-d" 'mail-insert-disposition-notification-to)
(define-key map "\C-c\C-t" 'mail-text)
(define-key map "\C-c\C-y" 'mail-yank-original)
(define-key map "\C-c\C-r" 'mail-yank-region)
@@ -325,6 +326,9 @@ The default value matches citations like `foo-bar>' plus whitespace."
(define-key map [menu-bar headers expand-aliases]
'("Expand Aliases" . expand-mail-aliases))
+ (define-key map [menu-bar headers disposition-notification]
+ '("Disposition-Notification-To" . mail-insert-disposition-notification-to))
+
(define-key map [menu-bar headers mail-reply-to]
'("Mail-Reply-To" . mail-mail-reply-to))
@@ -1598,6 +1602,25 @@ Returns non-nil if FIELD was originally present."
(interactive)
(expand-abbrev)
(goto-char (mail-text-start)))
+
+(defun mail-insert-disposition-notification-to ()
+ "Insert a Disposition-Notification-To header, if it doesn't already exist."
+ (interactive)
+ (expand-abbrev)
+ (save-excursion
+ (or (mail-position-on-field "Disposition-Notification-To")
+ (insert
+ (format
+ "%s"
+ (save-excursion
+ (save-restriction
+ (message-narrow-to-headers)
+ (or (mail-fetch-field "Reply-To")
+ (mail-fetch-field "From")
+ (with-temp-buffer
+ (mail-insert-from-field)
+ (substring (buffer-string) (length "From: ") -1))))))))))
+
(defun mail-signature (&optional atpoint)
"Sign letter with signature.
@@ -1927,7 +1950,8 @@ The seventh argument ACTIONS is a list of actions to take
(setq initialized t)))
(if (and buffer-auto-save-file-name
(file-exists-p buffer-auto-save-file-name))
- (message "Auto save file for draft message exists; consider M-x mail-recover"))
+ (message (substitute-command-keys
+ "Auto save file for draft message exists; consider \\[mail-recover]")))
initialized))
(declare-function dired-view-file "dired" ())
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 133a2e1828e..bd8aa611e94 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -516,7 +516,7 @@ for `smtpmail-try-auth-method'.")
(defun smtpmail-maybe-append-domain (recipient)
(if (or (not smtpmail-sendto-domain)
- (string-match "@" recipient))
+ (string-search "@" recipient))
recipient
(concat recipient "@" smtpmail-sendto-domain)))
@@ -596,7 +596,7 @@ USER and PASSWORD should be non-nil."
(error "Mechanism %S not implemented" mech))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql cram-md5)) user password)
+ (process (_mech (eql 'cram-md5)) user password)
(let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5")))
(when (eq (car ret) 334)
(let* ((challenge (substring (cadr ret) 4))
@@ -618,13 +618,13 @@ USER and PASSWORD should be non-nil."
(smtpmail-command-or-throw process encoded)))))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql login)) user password)
+ (process (_mech (eql 'login)) user password)
(smtpmail-command-or-throw process "AUTH LOGIN")
(smtpmail-command-or-throw process (base64-encode-string user t))
(smtpmail-command-or-throw process (base64-encode-string password t)))
(cl-defmethod smtpmail-try-auth-method
- (process (_mech (eql plain)) user password)
+ (process (_mech (eql 'plain)) user password)
;; We used to send an empty initial request, and wait for an
;; empty response, and then send the password, but this
;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this
@@ -636,6 +636,14 @@ USER and PASSWORD should be non-nil."
(base64-encode-string (concat "\0" user "\0" password) t))
235))
+(cl-defmethod smtpmail-try-auth-method
+ (process (_mech (eql xoauth2)) user password)
+ (smtpmail-command-or-throw
+ process
+ (concat "AUTH XOAUTH2 "
+ (base64-encode-string
+ (concat "user=" user "\1auth=Bearer " password "\1\1") t))))
+
(defun smtpmail-response-code (string)
(when string
(with-temp-buffer
@@ -692,7 +700,7 @@ Returns an error if the server cannot be contacted."
(let ((parts (split-string user-mail-address "@")))
(and (= (length parts) 2)
;; There's a dot in the domain name.
- (string-match "\\." (cadr parts))
+ (string-search "." (cadr parts))
user-mail-address))))
(defun smtpmail-via-smtp (recipient smtpmail-text-buffer
@@ -821,15 +829,15 @@ Returns an error if the server cannot be contacted."
(when (or (member 'onex supported-extensions)
(member 'xone supported-extensions))
- (smtpmail-command-or-throw process (format "ONEX")))
+ (smtpmail-command-or-throw process "ONEX"))
(when (and smtpmail-debug-verb
(or (member 'verb supported-extensions)
(member 'xvrb supported-extensions)))
- (smtpmail-command-or-throw process (format "VERB")))
+ (smtpmail-command-or-throw process "VERB"))
(when (member 'xusr supported-extensions)
- (smtpmail-command-or-throw process (format "XUSR")))
+ (smtpmail-command-or-throw process "XUSR"))
;; MAIL FROM:<sender>
(let ((size-part
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index d545b0c3f15..f393ac773f5 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -1299,7 +1299,7 @@ use it instead of `sc-citation-root-regexp'."
(defvar sc-fill-begin 1
"Buffer position to begin filling.")
(defvar sc-fill-line-prefix ""
- "Fill prefix of previous line")
+ "Fill prefix of previous line.")
;; filling
(defun sc-fill-if-different (&optional prefix)
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
index 9ebffef2e59..4347ff14022 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -30,6 +30,9 @@
;; uce-reply-to-uce. Please let me know about your changes so I can
;; incorporate them. I'd appreciate it.
+;; NOTE: We don't recommend using this feature; see the message in
+;; 'uce-reply-to-uce' for the reasons.
+
;; The command uce-reply-to-uce, if called when the current message
;; buffer is a UCE, will setup a reply *mail* buffer as follows. It
;; scans the full headers of the message for: 1) the normal return
@@ -213,6 +216,8 @@ These are mostly meant for headers that prevent delivery errors reporting."
(declare-function rmail-maybe-set-message-counters "rmail" ())
(declare-function rmail-toggle-header "rmail" (&optional arg))
+(defvar uce--usage-warning-displayed nil)
+
;;;###autoload
(defun uce-reply-to-uce (&optional _ignored)
"Compose a reply to unsolicited commercial email (UCE).
@@ -246,10 +251,10 @@ You might need to set `uce-mail-reader' before using this."
(if reply-to
(setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
(let (first-at-sign end-of-hostname sender-host)
- (setq first-at-sign (string-match "@" to)
+ (setq first-at-sign (string-search "@" to)
end-of-hostname (string-match "[ ,>]" to first-at-sign)
sender-host (substring to first-at-sign end-of-hostname))
- (if (string-match "\\." sender-host)
+ (if (string-search "." sender-host)
(setq to (format "%s, postmaster%s, abuse%s"
to sender-host sender-host))))
(setq mail-send-actions nil)
@@ -291,7 +296,7 @@ You might need to set `uce-mail-reader' before using this."
(search-forward " ")
(forward-char -1)
;; And add its postmaster to the list of addresses.
- (if (string-match "\\." (buffer-substring temp (point)))
+ (if (string-search "." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))
;; Also look at the message-id, it helps *very* often.
@@ -302,7 +307,7 @@ You might need to set `uce-mail-reader' before using this."
(setq temp (point))
(search-forward ">")
(forward-char -1)
- (if (string-match "\\." (buffer-substring temp (point)))
+ (if (string-search "." (buffer-substring temp (point)))
(setq to (format "%s, postmaster@%s"
to (buffer-substring temp (point)))))))
(when (eq uce-mail-reader 'gnus)
@@ -358,7 +363,32 @@ You might need to set `uce-mail-reader' before using this."
;; Run hooks before we leave buffer for editing. Reasonable usage
;; might be to set up special key bindings, replace standard
;; functions in mail-mode, etc.
- (run-hooks 'mail-setup-hook 'uce-setup-hook))))
+ (run-hooks 'mail-setup-hook 'uce-setup-hook)))
+ (unless uce--usage-warning-displayed
+ (setq uce--usage-warning-displayed t)
+ (pop-to-buffer (get-buffer-create "uce-reply-to-uce warning"))
+ (insert "\
+-- !!! NOTE !!! ---------------------------------------------
+
+Replying to spam is at best pointless, but most likely actively
+harmful.
+
+- You will confirm that your email address is valid, thus ensuring
+ you get more spam.
+
+- You will leak information and open yourself up for further
+ attack. For example, they could use your \"geolocation\" to find
+ your home address and phone number.
+
+- The sender address is likely fake.
+
+- You help them refine their methods of spamming.
+
+Therefore, we strongly recommend that you do not use this package.
+Use a spam filter instead, or just delete the spam.
+
+-------------------------------------------------------------
+")))
(defun uce-insert-ranting (&optional _ignored)
"Insert text of the usual reply to UCE into current buffer."
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index bf57ed6fa6f..0760a477296 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -125,7 +125,7 @@ See rmail-digest-methods."
;; Undo masking of separators inside digestified messages
(goto-char (point-min))
(while (search-forward
- (replace-regexp-in-string "\n-" "\n " separator) nil t)
+ (string-replace "\n-" "\n " separator) nil t)
(replace-match separator))
;; Return the list of marker pairs
(nreverse result))))))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-10 12:55:50 +0000