summaryrefslogtreecommitdiff
path: root/lisp/mail
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mail')
-rw-r--r--lisp/mail/emacsbug.el64
-rw-r--r--lisp/mail/feedmail.el25
-rw-r--r--lisp/mail/footnote.el2
-rw-r--r--lisp/mail/hashcash.el12
-rw-r--r--lisp/mail/ietf-drums-date.el274
-rw-r--r--lisp/mail/ietf-drums.el50
-rw-r--r--lisp/mail/mail-extr.el115
-rw-r--r--lisp/mail/mail-hist.el2
-rw-r--r--lisp/mail/mail-parse.el3
-rw-r--r--lisp/mail/mail-utils.el28
-rw-r--r--lisp/mail/mailalias.el37
-rw-r--r--lisp/mail/rfc2047.el2
-rw-r--r--lisp/mail/rmail.el38
-rw-r--r--lisp/mail/rmailedit.el4
-rw-r--r--lisp/mail/rmailkwd.el13
-rw-r--r--lisp/mail/rmailmm.el23
-rw-r--r--lisp/mail/rmailmsc.el4
-rw-r--r--lisp/mail/rmailout.el5
-rw-r--r--lisp/mail/rmailsort.el4
-rw-r--r--lisp/mail/rmailsum.el18
-rw-r--r--lisp/mail/sendmail.el66
-rw-r--r--lisp/mail/smtpmail.el45
-rw-r--r--lisp/mail/supercite.el18
-rw-r--r--lisp/mail/uce.el391
-rw-r--r--lisp/mail/undigest.el54
-rw-r--r--lisp/mail/unrmail.el2
26 files changed, 543 insertions, 756 deletions
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 1bda609d105..6cc99c21348 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -1,7 +1,6 @@
;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list -*- lexical-binding: t; -*-
-;; Copyright (C) 1985, 1994, 1997-1998, 2000-2022 Free Software
-;; Foundation, Inc.
+;; Copyright (C) 1985-2022 Free Software Foundation, Inc.
;; Author: K. Shane Hartman
;; Maintainer: emacs-devel@gnu.org
@@ -30,6 +29,9 @@
;; to complete the process. Alternatively, compose the bug report in
;; Emacs then paste it into your normal mail client.
+;; `M-x submit-emacs-patch' can be used to send a patch to the Emacs
+;; maintainers.
+
;;; Code:
(require 'sendmail)
@@ -40,9 +42,6 @@
:group 'maint
:group 'mail)
-(define-obsolete-variable-alias 'report-emacs-bug-pretest-address
- 'report-emacs-bug-address "24.1")
-
(defcustom report-emacs-bug-no-confirmation nil
"If non-nil, suppress the confirmations asked for the sake of novice users."
:type 'boolean)
@@ -348,10 +347,10 @@ usually do not have translators for other languages.\n\n")))
;; This is so the user has to type something in order to send easily.
(use-local-map (nconc (make-sparse-keymap) (current-local-map)))
- (define-key (current-local-map) "\C-c\C-i" #'info-emacs-bug)
+ (keymap-set (current-local-map) "C-c C-i" #'info-emacs-bug)
(if can-insert-mail
- (define-key (current-local-map) "\C-c\M-i"
- #'report-emacs-bug-insert-to-mailer))
+ (keymap-set (current-local-map) "C-c M-i"
+ #'report-emacs-bug-insert-to-mailer))
(setq report-emacs-bug-send-command (get mail-user-agent 'sendfunc)
report-emacs-bug-send-hook (get mail-user-agent 'hookvar))
(if report-emacs-bug-send-command
@@ -360,20 +359,23 @@ usually do not have translators for other languages.\n\n")))
(unless report-emacs-bug-no-explanations
(with-output-to-temp-buffer "*Bug Help*"
(princ "While in the mail buffer:\n\n")
- (if report-emacs-bug-send-command
- (princ (substitute-command-keys
- (format " Type \\[%s] to send the bug report.\n"
- report-emacs-bug-send-command))))
- (princ (substitute-command-keys
- " Type \\[kill-buffer] RET to cancel (don't send it).\n"))
- (if can-insert-mail
- (princ (substitute-command-keys
- " Type \\[report-emacs-bug-insert-to-mailer] to copy text to your preferred mail program.\n")))
- (terpri)
- (princ (substitute-command-keys
- " Type \\[info-emacs-bug] to visit in Info the Emacs Manual section
+ (let ((help
+ (substitute-command-keys
+ (format "%s%s%s%s"
+ (if report-emacs-bug-send-command
+ (format " Type \\[%s] to send the bug report.\n"
+ report-emacs-bug-send-command)
+ "")
+ " Type \\[kill-buffer] \\`RET' to cancel (don't send it).\n"
+ (if can-insert-mail
+ " Type \\[report-emacs-bug-insert-to-mailer] to \
+copy text to your preferred mail program.\n"
+ "")
+ " Type \\[info-emacs-bug] to visit in Info the Emacs Manual section
about when and how to write a bug report, and what
- information you should include to help fix the bug.")))
+ information you should include to help fix the bug."))))
+ (with-current-buffer "*Bug Help*"
+ (insert help))))
(shrink-window-if-larger-than-buffer (get-buffer-window "*Bug Help*")))
;; Make it less likely people will send empty messages.
(if report-emacs-bug-send-hook
@@ -488,15 +490,23 @@ and send the mail again%s."
Interactively, you will be prompted for SUBJECT and a patch FILE
name (which will be attached to the mail). You will end up in a
Message buffer where you can explain more about the patch."
- (interactive "sThis patch is about: \nfPatch file name: ")
+ (interactive
+ (let* ((file (read-file-name "Patch file name: "))
+ (guess (with-temp-buffer
+ (insert-file-contents file)
+ (mail-fetch-field "Subject"))))
+ (list (read-string (format-prompt "This patch is about" guess)
+ nil nil guess)
+ file)))
(switch-to-buffer "*Patch Help*")
(let ((inhibit-read-only t))
(erase-buffer)
(insert "Thank you for considering submitting a patch to the Emacs project.\n\n"
"Please describe what the patch fixes (or, if it's a new feature, what it\n"
- "implements) in the mail buffer below. When done, use the `C-c C-c' command\n"
+ "implements) in the mail buffer below. When done, use the "
+ (substitute-command-keys "\\<message-mode-map>\\[message-send-and-exit] command\n")
"to send the patch as an email to the Emacs issue tracker.\n\n"
- "If this is the first time you've submitted an Emacs patch, please\n"
+ "If this is the first time you're submitting an Emacs patch, please\n"
"read the ")
(insert-text-button
"CONTRIBUTE"
@@ -508,12 +518,14 @@ Message buffer where you can explain more about the patch."
(goto-char (point-min))
(view-mode 1)
(button-mode 1))
- (message-mail-other-window report-emacs-bug-address subject)
+ (compose-mail-other-window report-emacs-bug-address subject)
+ (message-goto-body)
(insert "\n\n\n")
(emacs-bug--system-description)
(mml-attach-file file "text/patch" nil "attachment")
(message-goto-body)
- (message "Write a description of the patch and use `C-c C-c' to send it")
+ (message "Write a description of the patch and use %s to send it"
+ (substitute-command-keys "\\[message-send-and-exit]"))
(add-hook 'message-send-hook
(lambda ()
(message-goto-body)
diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el
index fe686cb6f86..af12417f706 100644
--- a/lisp/mail/feedmail.el
+++ b/lisp/mail/feedmail.el
@@ -1317,7 +1317,7 @@ feedmail-queue-buffer-file-name is restored to nil.
Example advice for mail-send:
- (advice-add 'mail-send :around #'my-feedmail-mail-send-advice)
+ (advice-add \\='mail-send :around #\\='my-feedmail-mail-send-advice)
(defun my-feedmail-mail-send-advice (orig-fun &rest args)
(let ((feedmail-queue-buffer-file-name buffer-file-name)
(buffer-file-name nil))
@@ -1619,7 +1619,8 @@ local gurus."
(if (null mail-interactive) '("-oem" "-odb")))))
(declare-function smtpmail-via-smtp "smtpmail"
- (recipient smtpmail-text-buffer &optional ask-for-password))
+ (recipient smtpmail-text-buffer &optional ask-for-password
+ send-attempts))
(defvar smtpmail-smtp-server)
;; provided by jam@austin.asc.slb.com (James A. McLaughlin);
@@ -1742,7 +1743,7 @@ applied to a file after you've just read it from disk: for example, a
feedmail FQM message file from a queue. You could use something like
this:
- (add-to-list 'auto-mode-alist \\='(\"\\\\.fqm\\\\\\='\" . feedmail-vm-mail-mode))"
+ (add-to-list \\='auto-mode-alist \\='(\"\\\\.fqm\\\\\\='\" . feedmail-vm-mail-mode))"
(feedmail-say-debug ">in-> feedmail-vm-mail-mode")
(let ((the-buf (current-buffer)))
(vm-mail)
@@ -2336,19 +2337,14 @@ mapped to mostly alphanumerics for safety."
;; from a similar function in mail-utils.el
(defun feedmail-rfc822-time-zone (time)
+ (declare (obsolete format-time-string "29.1"))
(feedmail-say-debug ">in-> feedmail-rfc822-time-zone %s" time)
- (let* ((sec (or (car (current-time-zone time)) 0))
- (absmin (/ (abs sec) 60)))
- (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
+ (format-time-string "%z" time))
(defun feedmail-rfc822-date (arg-time)
(feedmail-say-debug ">in-> feedmail-rfc822-date %s" arg-time)
- (let ((time (or arg-time (current-time)))
- (system-time-locale "C"))
- (concat
- (format-time-string "%a, %e %b %Y %T " time)
- (feedmail-rfc822-time-zone time)
- )))
+ (let ((system-time-locale "C"))
+ (format-time-string "%a, %e %b %Y %T %z" arg-time)))
(defun feedmail-send-it-immediately-wrapper ()
"Wrapper to catch skip-me-i."
@@ -2847,10 +2843,9 @@ probably not appropriate for you."
(if (and (not feedmail-queue-use-send-time-for-message-id) maybe-file)
(setq date-time (file-attribute-modification-time
(file-attributes maybe-file))))
- (format "<%d-%s%s%s>"
+ (format "<%d-%s%s>"
(mod (random) 10000)
- (format-time-string "%a%d%b%Y%H%M%S" date-time)
- (feedmail-rfc822-time-zone date-time)
+ (format-time-string "%a%d%b%Y%H%M%S%z" date-time)
end-stuff))
)
diff --git a/lisp/mail/footnote.el b/lisp/mail/footnote.el
index 626fc1982d5..29e16c419be 100644
--- a/lisp/mail/footnote.el
+++ b/lisp/mail/footnote.el
@@ -898,7 +898,7 @@ play around with the following keys:
(make-local-variable 'footnote-end-tag)
(make-local-variable 'adaptive-fill-function)
- ;; Filladapt was an XEmacs package which is now in GNU ELPA.
+ ;; Filladapt is a GNU ELPA package.
(when (boundp 'filladapt-token-table)
;; add tokens to filladapt to match footnotes
;; 1] xxxxxxxxxxx x x x or [1] x x x x x x x
diff --git a/lisp/mail/hashcash.el b/lisp/mail/hashcash.el
index b343a017e34..eebb140088e 100644
--- a/lisp/mail/hashcash.el
+++ b/lisp/mail/hashcash.el
@@ -1,6 +1,6 @@
;;; hashcash.el --- Add hashcash payments to email -*- lexical-binding:t -*-
-;; Copyright (C) 2003-2005, 2007-2022 Free Software Foundation, Inc.
+;; Copyright (C) 2003-2022 Free Software Foundation, Inc.
;; Written by: Paul Foley <mycroft@actrix.gen.nz> (1997-2002)
;; Maintainer: emacs-devel@gnu.org
@@ -57,7 +57,7 @@
"The default number of bits to pay to unknown users.
If this is zero, no payment header will be generated.
See `hashcash-payment-alist'."
- :type 'integer
+ :type 'natnum
:group 'hashcash)
(defcustom hashcash-payment-alist '()
@@ -77,7 +77,7 @@ present, is the string to be hashed; if not present ADDR will be used."
(defcustom hashcash-default-accept-payment 20
"The default minimum number of bits to accept on incoming payments."
- :type 'integer
+ :type 'natnum
:group 'hashcash)
(defcustom hashcash-accept-resources `((,user-mail-address nil))
@@ -95,10 +95,12 @@ If this is not in your PATH, specify an absolute file name."
:type '(choice (const nil) file)
:group 'hashcash)
-(defcustom hashcash-extra-generate-parameters nil
+(defcustom hashcash-extra-generate-parameters '("-Z2")
"A list of parameter strings passed to `hashcash-program' when minting.
-For example, you may want to set this to (\"-Z2\") to reduce header length."
+For example, on very old hardware, you may want to set this
+to (\"-Z0\") to disable compression."
:type '(repeat string)
+ :version "29.1"
:group 'hashcash)
(defcustom hashcash-double-spend-database "hashcash.db"
diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el
new file mode 100644
index 00000000000..ddef7f11b66
--- /dev/null
+++ b/lisp/mail/ietf-drums-date.el
@@ -0,0 +1,274 @@
+;;; ietf-drums-date.el --- parse time/date for ietf-drums.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2022 Free Software Foundation, Inc.
+
+;; Author: Bob Rogers <rogers@rgrjr.com>
+;; Keywords: mail, util
+
+;; 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:
+
+;; 'ietf-drums-parse-date-string' parses a time and/or date in a
+;; string and returns a list of values, just like `decode-time', where
+;; unspecified elements in the string are returned as nil (except
+;; unspecified DST is returned as -1). `encode-time' may be applied
+;; on these values to obtain an internal time value.
+
+;; Historically, `parse-time-string' was used for this purpose, but it
+;; was gradually but imperfectly extended to handle other date
+;; formats. 'ietf-drums-parse-date-string' is compatible in that it
+;; uses the same return value format and parses the same email date
+;; formats by default, but can be made stricter if desired.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'parse-time)
+
+(define-error 'date-parse-error "Date/time parse error" 'error)
+
+(defconst ietf-drums-date--slot-names
+ '(second minute hour day month year weekday dst zone)
+ "Names of return value slots, for better error messages
+See the decoded-time defstruct.")
+
+(defconst ietf-drums-date--slot-ranges
+ '((0 60) (0 59) (0 23) (1 31) (1 12) (1 9999))
+ "Numeric slot ranges, for bounds checking.
+Note that RFC5322 explicitly requires that seconds go up to 60,
+to allow for leap seconds (see Mills, D., \"Network Time
+Protocol\", STD 12, RFC 1119, September 1989).")
+
+(defsubst ietf-drums-date--ignore-char-p (char)
+ ;; Ignore whitespace and commas.
+ (memq char '(?\s ?\t ?\r ?\n ?,)))
+
+(defun ietf-drums-date--tokenize-string (string &optional comment-eof)
+ "Turn STRING into tokens, separated only by whitespace and commas.
+Multiple commas are ignored. Pure digit sequences are turned
+into integers. If COMMENT-EOF is true, then a comment as
+defined by RFC5322 (strictly, the CFWS production that also
+accepts comments) is treated as an end-of-file, and no further
+tokens are recognized, otherwise we strip out all comments and
+treat them as whitespace (per RFC822)."
+ (let ((index 0)
+ (end (length string))
+ (list ()))
+ (cl-flet ((skip-ignored ()
+ ;; Skip ignored characters at index (the scan
+ ;; position). Skip RFC822 comments in matched parens,
+ ;; but do not complain about unterminated comments.
+ (let ((char nil)
+ (nest 0))
+ (while (and (< index end)
+ (setq char (aref string index))
+ (or (> nest 0)
+ (ietf-drums-date--ignore-char-p char)
+ (and (not comment-eof) (eql char ?\())))
+ (cl-incf index)
+ ;; FWS bookkeeping.
+ (cond ((and (eq char ?\\)
+ (< (1+ index) end))
+ ;; Move to the next char but don't check
+ ;; it to see if it might be a paren.
+ (cl-incf index))
+ ((eq char ?\() (cl-incf nest))
+ ((eq char ?\)) (cl-decf nest)))))))
+ (skip-ignored) ;; Skip leading whitespace.
+ (while (and (< index end)
+ (not (and comment-eof
+ (eq (aref string index) ?\())))
+ (let* ((start index)
+ (char (aref string index))
+ (all-digits (<= ?0 char ?9)))
+ ;; char is valid; look for more valid characters.
+ (when (and (eq char ?\\)
+ (< (1+ index) end))
+ ;; Escaped character, which might be a "(". If so, we are
+ ;; correct to include it in the token, even though the
+ ;; caller is sure to barf. If not, we violate RFC2?822 by
+ ;; not removing the backslash, but no characters in valid
+ ;; RFC2?822 dates need escaping anyway, so it shouldn't
+ ;; matter that this is not done strictly correctly. --
+ ;; rgr, 24-Dec-21.
+ (cl-incf index))
+ (while (and (< (cl-incf index) end)
+ (setq char (aref string index))
+ (not (or (ietf-drums-date--ignore-char-p char)
+ (eq char ?\())))
+ (unless (<= ?0 char ?9)
+ (setq all-digits nil))
+ (when (and (eq char ?\\)
+ (< (1+ index) end))
+ ;; Escaped character, see above.
+ (cl-incf index)))
+ (push (if all-digits
+ (cl-parse-integer string :start start :end index)
+ (substring string start index))
+ list)
+ (skip-ignored)))
+ (nreverse list))))
+
+(defun ietf-drums-parse-date-string (time-string &optional error no-822)
+ "Parse an RFC5322 or RFC822 date, passed as TIME-STRING.
+The optional ERROR parameter causes syntax errors to be flagged
+by signalling an instance of the date-parse-error condition. The
+optional NO-822 parameter disables the more lax RFC822 syntax,
+which is permitted by default.
+
+The result is a list of (SEC MIN HOUR DAY MON YEAR DOW DST TZ),
+which can be accessed as a decoded-time defstruct (q.v.),
+e.g. `decoded-time-year' to extract the year, and turned into an
+Emacs timestamp by `encode-time'.
+
+The strict syntax for RFC5322 is as follows:
+
+ [ day-of-week \",\" ] day FWS month-name FWS year FWS time [CFWS]
+
+where the \"time\" production is:
+
+ 2DIGIT \":\" 2DIGIT [ \":\" 2DIGIT ] FWS ( \"+\" / \"-\" ) 4DIGIT
+
+and FWS is \"folding white space,\" and CFWS is \"comments and/or
+folding white space\", where comments are included in nesting
+parentheses and are equivalent to white space. RFC822 also
+accepts comments in random places (all of which is handled by
+ietf-drums-date--tokenize-string) and two-digit years. For
+two-digit years, 50 and up are interpreted as 1950 through 1999
+and 00 through 49 as 200 through 2049.
+
+We are somewhat more lax in what we accept (specifically, the
+hours don't have to be two digits, and the TZ and the comma after
+the DOW are optional), but we do insist that the items that are
+present do appear in this order. Unspecified/unrecognized
+elements in the string are returned as nil (except unspecified
+DST is returned as -1)."
+ (let ((tokens (ietf-drums-date--tokenize-string (downcase time-string)
+ no-822))
+ (time (list nil nil nil nil nil nil nil -1 nil)))
+ (cl-labels ((set-matched-slot (slot index token)
+ ;; Assign a slot value from match data if index is
+ ;; non-nil, else from token, signalling an error if
+ ;; enabled and it's out of range.
+ (let ((value (if index
+ (cl-parse-integer (match-string index token))
+ token)))
+ (when error
+ (let ((range (nth slot ietf-drums-date--slot-ranges)))
+ (when (and range
+ (not (<= (car range) value (cadr range))))
+ (signal 'date-parse-error
+ (list "Slot out of range"
+ (nth slot ietf-drums-date--slot-names)
+ token (car range) (cadr range))))))
+ (setf (nth slot time) value)))
+ (set-numeric (slot token)
+ ;; Only assign the slot if the token is a number.
+ (cond ((natnump token)
+ (set-matched-slot slot nil token))
+ (error
+ (signal 'date-parse-error
+ (list "Not a number"
+ (nth slot ietf-drums-date--slot-names)
+ token))))))
+ ;; Check for weekday.
+ (let ((dow (assoc (car tokens) parse-time-weekdays)))
+ (when dow
+ ;; Day of the week.
+ (set-matched-slot 6 nil (cdr dow))
+ (pop tokens)))
+ ;; Day.
+ (set-numeric 3 (pop tokens))
+ ;; Alphabetic month.
+ (let* ((month (pop tokens))
+ (match (assoc month parse-time-months)))
+ (cond (match
+ (set-matched-slot 4 nil (cdr match)))
+ (error
+ (signal 'date-parse-error
+ (list "Expected an alphabetic month" month)))
+ (t
+ (push month tokens))))
+ ;; Year.
+ (let ((year (pop tokens)))
+ ;; Check the year for the right number of digits.
+ (cond ((not (natnump year))
+ (when error
+ (signal 'date-parse-error
+ (list "Expected a year" year)))
+ (push year tokens))
+ ((>= year 1000)
+ (set-numeric 5 year))
+ ((or no-822
+ (>= year 100))
+ (when error
+ (signal 'date-parse-error
+ (list "Four-digit years are required" year)))
+ (push year tokens))
+ ((>= year 50)
+ ;; second half of the 20th century.
+ (set-numeric 5 (+ 1900 year)))
+ (t
+ ;; first half of the 21st century.
+ (set-numeric 5 (+ 2000 year)))))
+ ;; Time.
+ (let ((time (pop tokens)))
+ (cond ((or (null time) (natnump time))
+ (when error
+ (signal 'date-parse-error
+ (list "Expected a time" time)))
+ (push time tokens))
+ ((string-match
+ "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\):\\([0-9][0-9]\\)$"
+ time)
+ (set-matched-slot 2 1 time)
+ (set-matched-slot 1 2 time)
+ (set-matched-slot 0 3 time))
+ ((string-match "^\\([0-9][0-9]?\\):\\([0-9][0-9]\\)$" time)
+ ;; Time without seconds.
+ (set-matched-slot 2 1 time)
+ (set-matched-slot 1 2 time)
+ (set-matched-slot 0 nil 0))
+ (error
+ (signal 'date-parse-error
+ (list "Expected a time" time)))))
+ ;; Timezone.
+ (let* ((zone (pop tokens))
+ (match (assoc zone parse-time-zoneinfo)))
+ (cond (match
+ (set-matched-slot 8 nil (cadr match))
+ (set-matched-slot 7 nil (caddr match)))
+ ((and (stringp zone)
+ (string-match "^[-+][0-9][0-9][0-9][0-9]$" zone))
+ ;; Numeric time zone.
+ (set-matched-slot
+ 8 nil
+ (* 60
+ (+ (cl-parse-integer zone :start 3 :end 5)
+ (* 60 (cl-parse-integer zone :start 1 :end 3)))
+ (if (= (aref zone 0) ?-) -1 1))))
+ ((and zone error)
+ (signal 'date-parse-error
+ (list "Expected a timezone" zone)))))
+ (when (and tokens error)
+ (signal 'date-parse-error
+ (list "Extra token(s)" (car tokens)))))
+ time))
+
+(provide 'ietf-drums-date)
+
+;;; ietf-drums-date.el ends here
diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el
index 51c3e63e044..d1ad671b160 100644
--- a/lisp/mail/ietf-drums.el
+++ b/lisp/mail/ietf-drums.el
@@ -25,16 +25,6 @@
;; library is based on draft-ietf-drums-msg-fmt-05.txt, released on
;; 1998-08-05.
-;; Pending a real regression self test suite, Simon Josefsson added
-;; various self test expressions snipped from bug reports, and their
-;; expected value, below. I you believe it could be useful, please
-;; add your own test cases, or write a real self test suite, or just
-;; remove this.
-
-;; <m3oekvfd50.fsf@whitebox.m5r.de>
-;; (ietf-drums-parse-address "'foo' <foo@example.com>")
-;; => ("foo@example.com" . "'foo'")
-
;;; Code:
(eval-when-compile (require 'cl-lib))
@@ -75,6 +65,21 @@ backslash and doublequote.")
(modify-syntax-entry ?\' "_" table)
table))
+(defvar ietf-drums-comment-syntax-table
+ (let ((table (copy-syntax-table ietf-drums-syntax-table)))
+ (modify-syntax-entry ?\" "w" table)
+ table)
+ "In comments, DQUOTE is normal and does not start a string.")
+
+(defun ietf-drums--skip-comment ()
+ ;; From just before the start of a comment, go to the end. Returns
+ ;; point. If the comment is unterminated, go to point-max.
+ (condition-case ()
+ (with-syntax-table ietf-drums-comment-syntax-table
+ (forward-sexp 1))
+ (scan-error (goto-char (point-max))))
+ (point))
+
(defun ietf-drums-token-to-list (token)
"Translate TOKEN into a list of characters."
(let ((i 0)
@@ -119,14 +124,7 @@ backslash and doublequote.")
(forward-sexp 1)
(error (goto-char (point-max)))))
((eq c ?\()
- (delete-region
- (point)
- (condition-case nil
- (with-syntax-table (copy-syntax-table ietf-drums-syntax-table)
- (modify-syntax-entry ?\" "w")
- (forward-sexp 1)
- (point))
- (error (point-max)))))
+ (delete-region (point) (ietf-drums--skip-comment)))
(t
(forward-char 1))))
(buffer-string))))
@@ -140,9 +138,11 @@ backslash and doublequote.")
(setq c (char-after))
(cond
((eq c ?\")
- (forward-sexp 1))
+ (condition-case ()
+ (forward-sexp 1)
+ (scan-error (goto-char (point-max)))))
((eq c ?\()
- (forward-sexp 1))
+ (ietf-drums--skip-comment))
((memq c '(?\ ?\t ?\n ?\r))
(delete-char 1))
(t
@@ -191,6 +191,8 @@ the Content-Transfer-Encoding header of a mail."
"Parse STRING and return a MAILBOX / DISPLAY-NAME pair.
If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
(that's the \"=?utf...q...=?\") stuff."
+ (when decode
+ (require 'rfc2047))
(with-temp-buffer
(let (display-name mailbox c display-string)
(ietf-drums-init string)
@@ -240,7 +242,7 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed
(cons
(mapconcat #'identity (nreverse display-name) "")
(ietf-drums-get-comment string)))
- (cons mailbox (if decode
+ (cons mailbox (if (and decode display-string)
(rfc2047-decode-string display-string)
display-string))))))
@@ -292,9 +294,13 @@ a list of address strings."
(replace-match " " t t))
(goto-char (point-min)))
+(declare-function ietf-drums-parse-date-string "ietf-drums-date"
+ (time-string &optional error? no-822?))
+
(defun ietf-drums-parse-date (string)
"Return an Emacs time spec from STRING."
- (encode-time (parse-time-string string)))
+ (require 'ietf-drums-date)
+ (encode-time (ietf-drums-parse-date-string string)))
(defun ietf-drums-narrow-to-header ()
"Narrow to the header section in the current buffer."
diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el
index 50ba04ccc1e..25ce4ea9025 100644
--- a/lisp/mail/mail-extr.el
+++ b/lisp/mail/mail-extr.el
@@ -1,7 +1,6 @@
;;; mail-extr.el --- extract full name and address from email header -*- lexical-binding: t; -*-
-;; Copyright (C) 1991-1994, 1997, 2001-2022 Free Software Foundation,
-;; Inc.
+;; Copyright (C) 1991-2022 Free Software Foundation, Inc.
;; Author: Joe Wells <jbw@cs.bu.edu>
;; Maintainer: emacs-devel@gnu.org
@@ -240,8 +239,7 @@ we will act as though we couldn't find a full name in the address."
;; Matches a leading title that is not part of the name (does not
;; contribute to uniquely identifying the person).
(defcustom mail-extr-full-name-prefixes
- (purecopy
- "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]")
+ "\\(Prof\\|D[Rr]\\|Mrs?\\|Rev\\|Rabbi\\|SysOp\\|LCDR\\)\\.?[ \t\n]"
"Matches prefixes to the full name that identify a person's position.
These are stripped from the full name because they do not contribute to
uniquely identifying the person."
@@ -279,45 +277,42 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Yes, there are weird people with digits in their names.
;; You will also notice the consideration for the
;; Swedish/Finnish/Norwegian character set.
-(defconst mail-extr-all-letters-but-separators
- (purecopy "][[:alnum:]{|}'~`"))
+(defconst mail-extr-all-letters-but-separators "][[:alnum:]{|}'~`")
;; Any character that can occur in a name in an RFC 822 (or later)
;; address including the separator (hyphen and possibly period) for
;; multipart names.
;; #### should . be in here?
(defconst mail-extr-all-letters
- (purecopy (concat mail-extr-all-letters-but-separators "-")))
+ (concat mail-extr-all-letters-but-separators "-"))
;; Any character that can start a name.
;; Keep this set as minimal as possible.
-(defconst mail-extr-first-letters (purecopy "[:alpha:]"))
+(defconst mail-extr-first-letters "[:alpha:]")
;; Any character that can end a name.
;; Keep this set as minimal as possible.
-(defconst mail-extr-last-letters (purecopy "[:alpha:]`'."))
+(defconst mail-extr-last-letters "[:alpha:]`'.")
(defconst mail-extr-leading-garbage "\\W+")
;; (defconst mail-extr-non-begin-name-chars
-;; (purecopy (concat "^" mail-extr-first-letters)))
+;; (concat "^" mail-extr-first-letters))
;; (defconst mail-extr-non-end-name-chars
-;; (purecopy (concat "^" mail-extr-last-letters)))
+;; (concat "^" mail-extr-last-letters))
;; Matches periods used instead of spaces. Must not match the period
;; following an initial.
(defconst mail-extr-bad-dot-pattern
- (purecopy
- (format "\\([%s][%s]\\)\\.+\\([%s]\\)"
- mail-extr-all-letters
- mail-extr-last-letters
- mail-extr-first-letters)))
+ (format "\\([%s][%s]\\)\\.+\\([%s]\\)"
+ mail-extr-all-letters
+ mail-extr-last-letters
+ mail-extr-first-letters))
;; Matches an embedded or leading nickname that should be removed.
;; (defconst mail-extr-nickname-pattern
-;; (purecopy
-;; (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] "
-;; mail-extr-all-letters)))
+;; (format "\\([ .]\\|\\`\\)[\"'`[(]\\([ .%s]+\\)[]\"')] "
+;; mail-extr-all-letters))
;; Matches the occurrence of a generational name suffix, and the last
;; character of the preceding name. This is important because we want to
@@ -325,59 +320,56 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; *** Perhaps this should be a user-customizable variable. However, the
;; *** regular expression is fairly tricky to alter, so maybe not.
(defconst mail-extr-full-name-suffix-pattern
- (purecopy
- (format
- "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)"
- mail-extr-all-letters mail-extr-all-letters)))
+ (format
+ "\\(,? ?\\([JjSs][Rr]\\.?\\|V?I+V?\\)\\)\\([^%s]\\([^%s]\\|\\'\\)\\|\\'\\)"
+ mail-extr-all-letters mail-extr-all-letters))
-(defconst mail-extr-roman-numeral-pattern (purecopy "V?I+V?\\b"))
+(defconst mail-extr-roman-numeral-pattern "V?I+V?\\b")
;; Matches a trailing uppercase (with other characters possible) acronym.
;; Must not match a trailing uppercase last name or trailing initial
(defconst mail-extr-weird-acronym-pattern
- (purecopy "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)"))
+ "\\([A-Z]+[-_/]\\|[A-Z][A-Z][A-Z]?\\b\\)")
;; Matches a mixed-case or lowercase name (not an initial).
;; #### Match Latin1 lower case letters here too?
;; (defconst mail-extr-mixed-case-name-pattern
-;; (purecopy
-;; (format
-;; "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)"
-;; mail-extr-all-letters mail-extr-last-letters
-;; mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters
-;; mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters)))
+;; (format
+;; "\\b\\([a-z][%s]*[%s]\\|[%s][%s]*[a-z][%s]*[%s]\\|[%s][%s]*[a-z]\\)"
+;; mail-extr-all-letters mail-extr-last-letters
+;; mail-extr-first-letters mail-extr-all-letters mail-extr-all-letters
+;; mail-extr-last-letters mail-extr-first-letters mail-extr-all-letters))
;; Matches a trailing alternative address.
;; #### Match Latin1 letters here too?
;; #### Match _ before @ here too?
(defconst mail-extr-alternative-address-pattern
- (purecopy "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]"))
+ "\\(aka *\\)?[a-zA-Z.]+[!@][a-zA-Z.]")
;; Matches a variety of trailing comments not including comma-delimited
;; comments.
(defconst mail-extr-trailing-comment-start-pattern
- (purecopy " [-{]\\|--\\|[+@#></;]"))
+ " [-{]\\|--\\|[+@#></;]")
;; Matches a name (not an initial).
;; This doesn't force a word boundary at the end because sometimes a
;; comment is separated by a `-' with no preceding space.
(defconst mail-extr-name-pattern
- (purecopy (format "\\b[%s][%s]*[%s]"
- mail-extr-first-letters
- mail-extr-all-letters
- mail-extr-last-letters)))
+ (format "\\b[%s][%s]*[%s]"
+ mail-extr-first-letters
+ mail-extr-all-letters
+ mail-extr-last-letters))
(defconst mail-extr-initial-pattern
- (purecopy (format "\\b[%s]\\([. ]\\|\\b\\)" mail-extr-first-letters)))
+ (format "\\b[%s]\\([. ]\\|\\b\\)" mail-extr-first-letters))
;; Matches a single name before a comma.
;; (defconst mail-extr-last-name-first-pattern
-;; (purecopy (concat "\\`" mail-extr-name-pattern ",")))
+;; (concat "\\`" mail-extr-name-pattern ","))
;; Matches telephone extensions.
(defconst mail-extr-telephone-extension-pattern
- (purecopy
- "\\(\\([Ee]xt\\|[Tt]ph\\|[Tt]el\\|[Xx]\\)\\.?\\)? *\\+?[0-9][- 0-9]+"))
+ "\\(\\([Ee]xt\\|[Tt]ph\\|[Tt]el\\|[Xx]\\)\\.?\\)? *\\+?[0-9][- 0-9]+")
;; Matches ham radio call signs.
;; Help from: Mat Maessen N2NJZ <maessm@rpi.edu>, Mark Feit
@@ -386,7 +378,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; KE9TV KF0NV N1API N3FU N3GZE N3IGS N4KCC N7IKQ N9HHU W4YHF W6ANK WA2SUH
;; WB7VZI N2NJZ NR3G KJ4KK AB4UM AL7NI KH6OH WN3KBT N4TMI W1A N0NZO
(defconst mail-extr-ham-call-sign-pattern
- (purecopy "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)"))
+ "\\b\\(DX[0-9]+\\|[AKNW][A-Z]?[0-9][A-Z][A-Z]?[A-Z]?\\)")
;; Possible trailing suffixes: "\\(/\\(KT\\|A[AEG]\\|[R0-9]\\)\\)?"
;; /KT == Temporary Technician (has CSC but not "real" license)
@@ -400,31 +392,29 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; Matches normal single-part name
(defconst mail-extr-normal-name-pattern
- (purecopy (format "\\b[%s][%s]+[%s]"
- mail-extr-first-letters
- mail-extr-all-letters-but-separators
- mail-extr-last-letters)))
+ (format "\\b[%s][%s]+[%s]"
+ mail-extr-first-letters
+ mail-extr-all-letters-but-separators
+ mail-extr-last-letters))
;; Matches a single word name.
;; (defconst mail-extr-one-name-pattern
-;; (purecopy (concat "\\`" mail-extr-normal-name-pattern "\\'")))
+;; (concat "\\`" mail-extr-normal-name-pattern "\\'"))
;; Matches normal two names with missing middle initial
;; The first name is not allowed to have a hyphen because this can cause
;; false matches where the "middle initial" is actually the first letter
;; of the second part of the first name.
(defconst mail-extr-two-name-pattern
- (purecopy
- (concat "\\`\\(" mail-extr-normal-name-pattern
- "\\|" mail-extr-initial-pattern
- "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)")))
+ (concat "\\`\\(" mail-extr-normal-name-pattern
+ "\\|" mail-extr-initial-pattern
+ "\\) +\\(" mail-extr-name-pattern "\\)\\(,\\|\\'\\)"))
(defconst mail-extr-listserv-list-name-pattern
- (purecopy "Multiple recipients of list \\([-A-Z]+\\)"))
+ "Multiple recipients of list \\([-A-Z]+\\)")
(defconst mail-extr-stupid-vms-date-stamp-pattern
- (purecopy
- "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *"))
+ "[0-9][0-9]-[JFMASOND][aepuco][nbrylgptvc]-[0-9][0-9][0-9][0-9] [0-9]+ *")
;;; HZ -- GB (PRC Chinese character encoding) in ASCII embedding protocol
;;
@@ -443,25 +433,23 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; mode from GB back to ASCII. (Note that the escape-from-GB code '~}'
;; ($7E7D) is outside the defined GB range.)
(defconst mail-extr-hz-embedded-gb-encoded-chinese-pattern
- (purecopy "~{\\([^~].\\|~[^}]\\)+~}"))
+ "~{\\([^~].\\|~[^}]\\)+~}")
;; The leading optional lowercase letters are for a bastardized version of
;; the encoding, as is the optional nature of the final slash.
(defconst mail-extr-x400-encoded-address-pattern
- (purecopy "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'"))
+ "[a-z]?[a-z]?\\(/[A-Za-z]+\\(\\.[A-Za-z]+\\)?=[^/]+\\)+/?\\'")
(defconst mail-extr-x400-encoded-address-field-pattern-format
- (purecopy "/%s=\\([^/]+\\)\\(/\\|\\'\\)"))
+ "/%s=\\([^/]+\\)\\(/\\|\\'\\)")
(defconst mail-extr-x400-encoded-address-surname-pattern
;; S stands for Surname (family name).
- (purecopy
- (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]")))
+ (format mail-extr-x400-encoded-address-field-pattern-format "[Ss]"))
(defconst mail-extr-x400-encoded-address-given-name-pattern
;; G stands for Given name.
- (purecopy
- (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]")))
+ (format mail-extr-x400-encoded-address-field-pattern-format "[Gg]"))
(defconst mail-extr-x400-encoded-address-full-name-pattern
;; PN stands for Personal Name. When used it represents the combination
@@ -469,8 +457,7 @@ by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"."
;; "The one system I used having this field asked it with the prompt
;; `Personal Name'. But they mapped it into G and S on outgoing real
;; X.400 addresses. As they mapped G and S into PN on incoming..."
- (purecopy
- (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]")))
+ (format mail-extr-x400-encoded-address-field-pattern-format "[Pp][Nn]"))
@@ -716,7 +703,6 @@ to the results."
value-list)
(with-current-buffer (get-buffer-create extraction-buffer)
- (fundamental-mode)
(buffer-disable-undo extraction-buffer)
(set-syntax-table mail-extr-address-syntax-table)
(widen)
@@ -738,7 +724,6 @@ to the results."
(set-text-properties (point-min) (point-max) nil)
(with-current-buffer (get-buffer-create canonicalization-buffer)
- (fundamental-mode)
(buffer-disable-undo canonicalization-buffer)
(setq case-fold-search nil))
diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el
index e02d4218dd2..a13f9de1740 100644
--- a/lisp/mail/mail-hist.el
+++ b/lisp/mail/mail-hist.el
@@ -80,7 +80,7 @@ previous/next input.")
(defcustom mail-hist-history-size (or kill-ring-max 1729)
"The maximum number of elements in a mail field's history.
Oldest elements are dumped first."
- :type 'integer)
+ :type 'natnum)
;;;###autoload
(defcustom mail-hist-keep-history t
diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el
index 23894e59b77..ec719850e2e 100644
--- a/lisp/mail/mail-parse.el
+++ b/lisp/mail/mail-parse.el
@@ -76,7 +76,8 @@
The return value is a list with mail/name pairs."
(delq nil
(mapcar (lambda (elem)
- (or (mail-header-parse-address elem)
+ (or (ignore-errors
+ (mail-header-parse-address elem))
(mail-header-parse-address-lax elem)))
(mail-header-parse-addresses string t))))
diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el
index 9711dc7db12..63752f953a7 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -59,7 +59,7 @@ also the To field, unless this would leave an empty To field."
(defun mail-string-delete (string start end)
"Return a string containing all of STRING except the part
from START (inclusive) to END (exclusive)."
- ;; FIXME: This is not used anywhere. Make obsolete?
+ (declare (obsolete substring "29.1"))
(if (null end) (substring string 0 start)
(concat (substring string 0 start)
(substring string end nil))))
@@ -239,12 +239,8 @@ comma-separated list, and return the pruned list."
;; Or just set the default directly in the defcustom.
(if (null mail-dont-reply-to-names)
(setq mail-dont-reply-to-names
- ;; `rmail-default-dont-reply-to-names' is obsolete.
- (let ((a (bound-and-true-p rmail-default-dont-reply-to-names))
- (b (if (> (length user-mail-address) 0)
- (concat "\\`" (regexp-quote user-mail-address) "\\'"))))
- (cond ((and a b) (concat a "\\|" b))
- ((or a b))))))
+ (if (> (length user-mail-address) 0)
+ (concat "\\`" (regexp-quote user-mail-address) "\\'"))))
;; Split up DESTINATIONS and match each element separately.
(let ((start-pos 0) (cur-pos 0)
(case-fold-search t))
@@ -281,9 +277,6 @@ comma-separated list, and return the pruned list."
(substring destinations (match-end 0))
destinations))
-;; Legacy name
-(define-obsolete-function-alias 'rmail-dont-reply-to #'mail-dont-reply-to "24.1")
-
;;;###autoload
(defun mail-fetch-field (field-name &optional last all list delete)
@@ -368,19 +361,12 @@ matches may be returned from the message body."
labels)
(defun mail-rfc822-time-zone (time)
- (let* ((sec (or (car (current-time-zone time)) 0))
- (absmin (/ (abs sec) 60)))
- (format "%c%02d%02d" (if (< sec 0) ?- ?+) (/ absmin 60) (% absmin 60))))
+ (declare (obsolete format-time-string "29.1"))
+ (format-time-string "%z" time))
(defun mail-rfc822-date ()
- (let* ((time (current-time))
- (s (current-time-string time)))
- (string-match "[^ ]+ +\\([^ ]+\\) +\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)" s)
- (concat (substring s (match-beginning 2) (match-end 2)) " "
- (substring s (match-beginning 1) (match-end 1)) " "
- (substring s (match-beginning 4) (match-end 4)) " "
- (substring s (match-beginning 3) (match-end 3)) " "
- (mail-rfc822-time-zone time))))
+ (let ((system-time-locale "C"))
+ (format-time-string "%-d %b %Y %T %z")))
(defun mail-mbox-from ()
"Return an mbox \"From \" line for the current message.
diff --git a/lisp/mail/mailalias.el b/lisp/mail/mailalias.el
index ba7cf58d383..57fb1117b60 100644
--- a/lisp/mail/mailalias.el
+++ b/lisp/mail/mailalias.el
@@ -72,11 +72,10 @@ When t this still needs to be initialized.")
)
"Alist of header field and expression to return alist for completion.
The expression may reference the variable `pattern'
-which will hold the string being completed.
-If not on matching header, `mail-complete-function' gets called instead."
+which will hold the string being completed."
:type 'alist
+ :risky t
:group 'mailalias)
-(put 'mail-complete-alist 'risky-local-variable t)
;;;###autoload
(defcustom mail-complete-style 'angles
@@ -90,13 +89,6 @@ If `angles', they look like:
:type '(choice (const angles) (const parens) (const nil))
:group 'mailalias)
-(defcustom mail-complete-function 'ispell-complete-word
- "Function to call when completing outside `mail-complete-alist'-header."
- :type '(choice function (const nil))
- :group 'mailalias)
-(make-obsolete-variable 'mail-complete-function
- 'completion-at-point-functions "24.1")
-
(defcustom mail-directory-function nil
"Function to get completions from directory service or nil for none.
See `mail-directory-requery'."
@@ -129,8 +121,8 @@ or like this:
(remote-shell-program \"HOST\" \"-n\" \"COMMAND \\='^\" pattern \"\\='\")"
:type 'sexp
+ :risky t
:group 'mailalias)
-(put 'mail-directory-process 'risky-local-variable t)
(defcustom mail-directory-stream nil
"List of (HOST SERVICE) for stream connection to mail directory."
@@ -140,8 +132,8 @@ or like this:
(string :tag "Service name"))
(plist :inline t
:tag "Additional open-network-stream parameters")))
+ :risky t
:group 'mailalias)
-(put 'mail-directory-stream 'risky-local-variable t)
(defcustom mail-directory-parser nil
"How to interpret the output of `mail-directory-function'.
@@ -151,8 +143,8 @@ Three types of values are possible:
- regexp means first \\(grouping\\) in successive matches is name
- function called at beginning of buffer that returns an alist of names"
:type '(choice (const nil) regexp function)
+ :risky t
:group 'mailalias)
-(put 'mail-directory-parser 'risky-local-variable t)
;; Internal variables.
@@ -433,25 +425,6 @@ For use on `completion-at-point-functions'."
(let ((pattern prefix)) (eval list-exp))))))
(list beg end table)))))
-;;;###autoload
-(defun mail-complete (arg)
- "Perform completion on header field or word preceding point.
-Completable headers are according to `mail-complete-alist'. If none matches
-current header, calls `mail-complete-function' and passes prefix ARG if any."
- (declare (obsolete mail-completion-at-point-function "24.1"))
- (interactive "P")
- ;; Read the defaults first, if we have not done so.
- (sendmail-sync-aliases)
- (if (eq mail-aliases t)
- (progn
- (setq mail-aliases nil)
- (if (file-exists-p mail-personal-alias-file)
- (build-mail-aliases))))
- (let ((data (mail-completion-at-point-function)))
- (if data
- (apply #'completion-in-region data)
- (funcall mail-complete-function arg))))
-
(defun mail-completion-expand (table)
"Build new completion table that expands aliases.
Completes like TABLE except that if the completion is a valid alias,
diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el
index b3c45100f6d..bb0d646346c 100644
--- a/lisp/mail/rfc2047.el
+++ b/lisp/mail/rfc2047.el
@@ -46,7 +46,7 @@
("Followup-To" . nil)
("Message-ID" . nil)
("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\
-\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime)
+\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\|Disposition-Notification-To\\)" . address-mime)
(t . mime))
"Header/encoding method alist.
The list is traversed sequentially. The keys can either be
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 49eaeb560e0..71eda7cd2b0 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -41,8 +41,6 @@
(require 'rfc2047)
(require 'auth-source)
-(require 'rmail-loaddefs)
-
(declare-function compilation--message->loc "compile" (cl-x) t)
(declare-function epa--find-coding-system-for-mime-charset "epa" (mime-charset))
@@ -317,20 +315,6 @@ Setting this variable has an effect only before reading a mail."
:version "21.1")
;;;###autoload
-(define-obsolete-variable-alias 'rmail-dont-reply-to-names
- 'mail-dont-reply-to-names "24.1")
-
-;; Prior to 24.1, this used to contain "\\`info-".
-;;;###autoload
-(defvar rmail-default-dont-reply-to-names nil
- "Regexp specifying part of the default value of `mail-dont-reply-to-names'.
-This is used when the user does not set `mail-dont-reply-to-names'
-explicitly.")
-;;;###autoload
-(make-obsolete-variable 'rmail-default-dont-reply-to-names
- 'mail-dont-reply-to-names "24.1")
-
-;;;###autoload
(defcustom rmail-ignored-headers
(purecopy
(concat "^via:\\|^mail-from:\\|^origin:\\|^references:\\|^sender:"
@@ -390,7 +374,7 @@ If nil, display all header fields except those matched by
;;;###autoload
(defcustom rmail-retry-ignored-headers (purecopy "^x-authentication-warning:\\|^x-detected-operating-system:\\|^x-spam[-a-z]*:\\|content-type:\\|content-transfer-encoding:\\|mime-version:\\|message-id:")
"Headers that should be stripped when retrying a failed message."
- :type '(choice regexp (const nil :tag "None"))
+ :type '(choice regexp (const :value nil :tag "None"))
:group 'rmail-headers
:version "23.2") ; added x-detected-operating-system, x-spam
@@ -464,8 +448,8 @@ as argument, to ask the user that question."
(const :tag "Confirm with y-or-n-p" y-or-n-p)
(const :tag "Confirm with yes-or-no-p" yes-or-no-p))
:version "21.1"
+ :risky t
:group 'rmail-files)
-(put 'rmail-confirm-expunge 'risky-local-variable t)
;;;###autoload
(defvar rmail-mode-hook nil
@@ -539,7 +523,7 @@ Examples:
;; Note: this is matched with case-fold-search bound to t.
(defcustom rmail-re-abbrevs
"\\(RE\\|رد\\|回复\\|回覆\\|SV\\|Antw\\|VS\\|REF\\|AW\\|ΑΠ\\|ΣΧΕΤ\\|השב\\|Vá\\|R\\|RIF\\|BLS\\|RES\\|Odp\\|YNT\\|ATB\\)"
- "Regexp with localized 'Re:' abbreviations in various languages."
+ "Regexp with localized \"Re:\" abbreviations in various languages."
:version "28.1"
:type 'regexp)
@@ -1467,7 +1451,6 @@ If so restore the actual mbox message collection."
(setq-local font-lock-defaults
'(rmail-font-lock-keywords
t t nil nil
- (font-lock-maximum-size . nil)
(font-lock-dont-widen . t)
(font-lock-inhibit-thing-lock . (lazy-lock-mode fast-lock-mode))))
(setq-local require-final-newline nil)
@@ -4125,10 +4108,8 @@ typically for purposes of moderating a list."
"A regexp that matches the separator before the text of a failed message.")
(defvar mail-mime-unsent-header "^Content-Type: message/rfc822 *$"
- "A regexp that matches the header of a MIME body part with a failed message.")
+ "A regexp that matches the header of a MIME body part with a failed message.")
-;; This is a cut-down version of rmail-clear-headers from Emacs 22.
-;; It doesn't have the same functionality, hence the name change.
(defun rmail-delete-headers (regexp)
"Delete any mail headers matching REGEXP.
The message should be narrowed to just the headers."
@@ -4136,10 +4117,6 @@ The message should be narrowed to just the headers."
(goto-char (point-min))
(while (re-search-forward regexp nil t)
(beginning-of-line)
- ;; This code from Emacs 22 doesn't seem right, since r-n-h is
- ;; just for display.
-;;; (if (looking-at rmail-nonignored-headers)
-;;; (forward-line 1)
(delete-region (point)
(save-excursion
(if (re-search-forward "\n[^ \t]" nil t)
@@ -4497,10 +4474,7 @@ password."
:max 1 :user user :host host
:require '(:secret)))))
(if found
- (let ((secret (plist-get found :secret)))
- (if (functionp secret)
- (funcall secret)
- secret))
+ (auth-info-password found)
(read-passwd (if imap
"IMAP password: "
"POP password: "))))))
@@ -4603,8 +4577,6 @@ Argument MIME is non-nil if this is a mime message."
armor-end-regexp
(buffer-substring armor-start (- (point-max) after-end)))))
-(declare-function rmail-mime-entity-truncated "rmailmm" (entity))
-
;; Should this have a key-binding, or be in a menu?
;; There doesn't really seem to be an appropriate menu.
;; Eg the edit command is not in a menu either.
diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el
index d6eee405dd1..79bd02fd67e 100644
--- a/lisp/mail/rmailedit.el
+++ b/lisp/mail/rmailedit.el
@@ -484,8 +484,4 @@ HEADER-DIFF should be a return value from `rmail-edit-diff-headers'."
(provide 'rmailedit)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailedit.el ends here
diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el
index f2b80b689f1..6535d68456b 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))))
@@ -191,8 +188,4 @@ With prefix argument N moves forward N messages with these labels."
(provide 'rmailkwd)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailkwd.el ends here
diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el
index 0d0e83f2a58..79f421bdcd6 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))
@@ -796,17 +796,14 @@ directly."
((string-match "text/" content-type)
(setq type 'text))
((string-match "image/\\(.*\\)" content-type)
- (setq type (image-type-from-file-name
+ (setq type (image-supported-file-p
(concat "." (match-string 1 content-type))))
- (if (and (boundp 'image-types)
- (memq type image-types)
- (image-type-available-p type))
- (if (and rmail-mime-show-images
- (not (eq rmail-mime-show-images 'button))
- (or (not (numberp rmail-mime-show-images))
- (< size rmail-mime-show-images)))
- (setq to-show t))
- (setq type nil))))
+ (when (and type
+ rmail-mime-show-images
+ (not (eq rmail-mime-show-images 'button))
+ (or (not (numberp rmail-mime-show-images))
+ (< size rmail-mime-show-images)))
+ (setq to-show t))))
(setcar bulk-data size)
(setcdr bulk-data type)
to-show))
@@ -1569,8 +1566,4 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'."
(provide 'rmailmm)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailmm.el ends here
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
index 26bf651f22d..93463af46cf 100644
--- a/lisp/mail/rmailmsc.el
+++ b/lisp/mail/rmailmsc.el
@@ -54,8 +54,4 @@ This applies only to the current session."
(setq rmail-inbox-list inbox-list)))
(rmail-show-message-1 rmail-current-message))
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailmsc.el ends here
diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el
index 0d996e65403..c1371308d4f 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))))
diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el
index d6fe312efe3..c203cf858e5 100644
--- a/lisp/mail/rmailsort.el
+++ b/lisp/mail/rmailsort.el
@@ -250,8 +250,4 @@ Numeric keys are sorted numerically, all others as strings."
(provide 'rmailsort)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailsort.el ends here
diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el
index 54dce3c4673..b23fbc3f600 100644
--- a/lisp/mail/rmailsum.el
+++ b/lisp/mail/rmailsum.el
@@ -1475,18 +1475,16 @@ argument says to read a file name and use that file as the inbox."
(forward-line -1))
(declare-function rmail-abort-edit "rmailedit" ())
-(declare-function rmail-cease-edit "rmailedit"())
+(declare-function rmail-cease-edit "rmailedit" (&optional abort))
(declare-function rmail-set-label "rmailkwd" (l state &optional n))
(declare-function rmail-output-read-file-name "rmailout" ())
(declare-function mail-send-and-exit "sendmail" (&optional arg))
-(defvar rmail-summary-edit-map nil)
-(if rmail-summary-edit-map
- nil
- (setq rmail-summary-edit-map
- (nconc (make-sparse-keymap) text-mode-map))
- (define-key rmail-summary-edit-map "\C-c\C-c" 'rmail-cease-edit)
- (define-key rmail-summary-edit-map "\C-c\C-]" 'rmail-abort-edit))
+(defvar rmail-summary-edit-map
+ (let ((map (nconc (make-sparse-keymap) text-mode-map)))
+ (define-key map "\C-c\C-c" #'rmail-cease-edit)
+ (define-key map "\C-c\C-]" #'rmail-abort-edit)
+ map))
(defun rmail-summary-edit-current-message ()
"Edit the contents of this message."
@@ -1879,8 +1877,4 @@ the summary is only showing a subset of messages."
(provide 'rmailsum)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; rmailsum.el ends here
diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el
index ccb112cda6f..8cb079f7fbe 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -372,8 +372,8 @@ and should insert whatever you want to insert."
:type '(choice (const :tag "None" nil)
(const :tag "Use `.signature' file" t)
(string :tag "String to insert")
- (sexp :tag "Expression to evaluate")))
-(put 'mail-signature 'risky-local-variable t)
+ (sexp :tag "Expression to evaluate"))
+ :risky t)
;;;###autoload
(defcustom mail-signature-file (purecopy "~/.signature")
@@ -430,20 +430,6 @@ support Delivery Status Notification."
(const :tag "Success" success)))
:version "22.1")
-;; Note: could use /usr/ucb/mail instead of sendmail;
-;; options -t, and -v if not interactive.
-(defvar mail-mailer-swallows-blank-line nil
- "Set this non-nil if the system's mailer runs the header and body together.
-The actual value should be an expression to evaluate that returns
-non-nil if the problem will actually occur.
-\(As far as we know, this is not an issue on any system still supported
-by Emacs.)")
-
-(put 'mail-mailer-swallows-blank-line 'risky-local-variable t) ; gets evalled
-(make-obsolete-variable 'mail-mailer-swallows-blank-line
- "no need to set this on any modern system."
- "24.1" 'set)
-
(defvar mail-mode-syntax-table
;; define-derived-mode will make it inherit from text-mode-syntax-table.
(let ((st (make-syntax-table)))
@@ -877,7 +863,7 @@ The variable is used to trigger insertion of the \"Mail-Followup-To\"
header when sending a message to a mailing list."
:type '(repeat string))
-(declare-function mml-to-mime "mml" ())
+(declare-function mm-long-lines-p "mm-bodies" (length))
(defun mail-send ()
"Send the message in the current buffer.
@@ -955,7 +941,11 @@ the user from the mailer."
(error "Invalid header line (maybe a continuation line lacks initial whitespace)"))
(forward-line 1)))
(goto-char opoint)
- (when mail-encode-mml
+ (require 'mml)
+ (when (or mail-encode-mml
+ ;; When we have long lines, we have to MIME encode
+ ;; to get line folding.
+ (mm-long-lines-p 1000))
(mml-to-mime)
(setq mail-encode-mml nil))
(run-hooks 'mail-send-hook)
@@ -1305,8 +1295,6 @@ external program defined by `sendmail-program'."
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
- (if (eval mail-mailer-swallows-blank-line)
- (newline))
;; Find and handle any Fcc fields.
(goto-char (point-min))
(if (re-search-forward "^Fcc:" delimline t)
@@ -1391,8 +1379,7 @@ just append to the file, in Babyl format if necessary."
(unless (markerp header-end)
(error "Value of `header-end' must be a marker"))
(let (fcc-list
- (mailbuf (current-buffer))
- (time (current-time)))
+ (mailbuf (current-buffer)))
(save-excursion
(goto-char (point-min))
(let ((case-fold-search t))
@@ -1408,14 +1395,11 @@ just append to the file, in Babyl format if necessary."
(with-temp-buffer
;; This initial newline is not written out if we create a new
;; file (see below).
- (insert "\nFrom " (user-login-name) " " (current-time-string time) "\n")
- ;; Insert the time zone before the year.
- (forward-char -1)
- (forward-word-strictly -1)
(require 'mail-utils)
- (insert (mail-rfc822-time-zone time) " ")
- (goto-char (point-max))
- (insert "Date: " (message-make-date) "\n")
+ (insert "\nFrom " (user-login-name) " "
+ (let ((system-time-locale "C"))
+ (format-time-string "%a %b %e %T %z %Y"))
+ "\nDate: " (message-make-date) "\n")
(insert-buffer-substring mailbuf)
;; Make sure messages are separated.
(goto-char (point-max))
@@ -1495,28 +1479,6 @@ just append to the file, in Babyl format if necessary."
(with-current-buffer buffer
(set-visited-file-modtime)))))))))
-(defun mail-sent-via ()
- "Make a Sent-via header line from each To or Cc header line."
- (declare (obsolete "nobody can remember what it is for." "24.1"))
- (interactive)
- (save-excursion
- ;; put a marker at the end of the header
- (let ((end (copy-marker (mail-header-end)))
- (case-fold-search t))
- (goto-char (point-min))
- ;; search for the To: lines and make Sent-via: lines from them
- ;; search for the next To: line
- (while (re-search-forward "^\\(to\\|cc\\):" end t)
- ;; Grab this line plus all its continuations, sans the `to:'.
- (let ((to-line
- (buffer-substring (point)
- (progn
- (if (re-search-forward "^[^ \t\n]" end t)
- (backward-char 1)
- (goto-char end))
- (point)))))
- ;; Insert a copy, with altered header field name.
- (insert-before-markers "Sent-via:" to-line))))))
(defun mail-to ()
"Move point to end of To field, creating it if necessary."
@@ -1839,8 +1801,6 @@ If the current line has `mail-yank-prefix', insert it on the new line."
(or (bolp) (newline))
(goto-char start))))
-(define-obsolete-function-alias 'mail-attach-file #'mail-insert-file "24.1")
-
(declare-function mml-attach-file "mml"
(file &optional type description disposition))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 33458178a51..45b25b55301 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -171,7 +171,7 @@ attempt."
"The number of times smtpmail will retry sending when getting transient errors.
These are errors with a code of 4xx from the SMTP server, which
mean \"try again\"."
- :type 'integer
+ :type 'natnum
:version "27.1")
(defcustom smtpmail-store-queue-variables nil
@@ -342,8 +342,6 @@ for `smtpmail-try-auth-method'.")
;; Insert an extra newline if we need it to work around
;; Sun's bug that swallows newlines.
(goto-char (1+ delimline))
- (if (eval mail-mailer-swallows-blank-line t)
- (newline))
;; Find and handle any Fcc fields.
(goto-char (point-min))
(if (re-search-forward "^Fcc:" delimline t)
@@ -552,13 +550,10 @@ for `smtpmail-try-auth-method'.")
:require (and ask-for-password
'(:user :secret))
:create ask-for-password)))
- (mech (or (plist-get auth-info :smtp-auth) (car mechs)))
(user (plist-get auth-info :user))
- (password (plist-get auth-info :secret))
+ (password (auth-info-password auth-info))
(save-function (and ask-for-password
(plist-get auth-info :save-function))))
- (when (functionp password)
- (setq password (funcall password)))
(when (and user
(not password))
;; The user has stored the user name, but not the password, so
@@ -573,21 +568,27 @@ for `smtpmail-try-auth-method'.")
:user smtpmail-smtp-user
:require '(:user :secret)
:create t))
- password (plist-get auth-info :secret)))
- (when (functionp password)
- (setq password (funcall password)))
- (let ((result (catch 'done
- (if (and mech user password)
- (smtpmail-try-auth-method process mech user password)
- ;; No mechanism, or no credentials.
- mech))))
- (if (stringp result)
- (progn
- (auth-source-forget+ :host host :port port)
- (throw 'done result))
- (when save-function
- (funcall save-function))
- result))))
+ password (auth-info-password auth-info)))
+ (let ((mechs (or (ensure-list (plist-get auth-info :smtp-auth))
+ mechs))
+ (result ""))
+ (when (and mechs user password)
+ (while (and mechs
+ (stringp result))
+ (setq result (catch 'done
+ (smtpmail-try-auth-method
+ process (pop mechs) user password))))
+ ;; A string result is an error.
+ (if (stringp result)
+ (progn
+ ;; All methods failed.
+ ;; Forget the credentials.
+ (auth-source-forget+ :host host :port port)
+ (throw 'done result))
+ ;; Success.
+ (when save-function
+ (funcall save-function))
+ result)))))
(cl-defgeneric smtpmail-try-auth-method (_process mech _user _password)
"Perform authentication of type MECH for USER with PASSWORD.
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index b56ceed2cc0..f320246f2de 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -146,8 +146,8 @@ a variable whose value is a citation frame."
:type '(repeat (list symbol (repeat (cons regexp
(choice (repeat (repeat sexp))
symbol)))))
+ :risky t
:group 'supercite-frames)
-(put 'sc-cite-frame-alist 'risky-local-variable t)
(defcustom sc-uncite-frame-alist '()
"Alist for frame selection during unciting.
@@ -155,8 +155,8 @@ See the variable `sc-cite-frame-alist' for details."
:type '(repeat (list symbol (repeat (cons regexp
(choice (repeat (repeat sexp))
symbol)))))
+ :risky t
:group 'supercite-frames)
-(put 'sc-uncite-frame-alist 'risky-local-variable t)
(defcustom sc-recite-frame-alist '()
"Alist for frame selection during reciting.
@@ -164,8 +164,8 @@ See the variable `sc-cite-frame-alist' for details."
:type '(repeat (list symbol (repeat (cons regexp
(choice (repeat (repeat sexp))
symbol)))))
+ :risky t
:group 'supercite-frames)
-(put 'sc-recite-frame-alist 'risky-local-variable t)
(defcustom sc-default-cite-frame
'(;; initialize fill state and temporary variables when entering
@@ -211,8 +211,8 @@ See the variable `sc-cite-frame-alist' for details."
(end (sc-fill-if-different "")))
"Default REGI frame for citing a region."
:type '(repeat (repeat sexp))
+ :risky t
:group 'supercite-frames)
-(put 'sc-default-cite-frame 'risky-local-variable t)
(defcustom sc-default-uncite-frame
'(;; do nothing on a blank line
@@ -221,8 +221,8 @@ See the variable `sc-cite-frame-alist' for details."
((sc-cite-regexp) (sc-uncite-line)))
"Default REGI frame for unciting a region."
:type '(repeat (repeat sexp))
+ :risky t
:group 'supercite-frames)
-(put 'sc-default-uncite-frame 'risky-local-variable t)
(defcustom sc-default-recite-frame
'(;; initialize fill state when entering frame
@@ -237,8 +237,8 @@ See the variable `sc-cite-frame-alist' for details."
(end (sc-fill-if-different "")))
"Default REGI frame for reciting a region."
:type '(repeat (repeat sexp))
+ :risky t
:group 'supercite-frames)
-(put 'sc-default-recite-frame 'risky-local-variable t)
(defcustom sc-cite-region-limit t
"This variable controls automatic citation of yanked text.
@@ -428,8 +428,8 @@ to be consulted during attribution selection."
(repeat (cons regexp
(choice (sexp :tag "List to eval")
string)))))
+ :risky t
:group 'supercite-attr)
-(put 'sc-attrib-selection-list 'risky-local-variable t)
(defcustom sc-attribs-preselect-hook nil
"Hook to run before selecting an attribution."
@@ -483,8 +483,8 @@ The variable `sc-preferred-header-style' controls which function in
this list is chosen for automatic reference header insertions.
Electric reference mode will cycle through this list of functions."
:type '(repeat sexp)
+ :risky t
:group 'supercite)
-(put 'sc-rewrite-header-list 'risky-local-variable t)
(defcustom sc-titlecue-regexp "\\s +-+\\s +"
"Regular expression describing the separator between names and titles.
@@ -1767,7 +1767,7 @@ is determined non-interactively. The value is queried for in the
minibuffer exactly the same way that `set-variable' does it.
You can see the current value of the variable when the minibuffer is
-querying you by typing `C-h'. Note that the format is changed
+querying you by typing \\`C-h'. Note that the format is changed
slightly from that used by `set-variable' -- the current value is
printed just after the variable's name instead of at the bottom of the
help window."
diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el
deleted file mode 100644
index 9e367dc6349..00000000000
--- a/lisp/mail/uce.el
+++ /dev/null
@@ -1,391 +0,0 @@
-;;; uce.el --- facilitate reply to unsolicited commercial email -*- lexical-binding: t; -*-
-
-;; Copyright (C) 1996, 1998, 2000-2022 Free Software Foundation, Inc.
-
-;; Author: stanislav shalunov <shalunov@mccme.ru>
-;; Created: 10 Dec 1996
-;; Keywords: mail, uce, unsolicited commercial email
-
-;; 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:
-
-;; The code in this file provides a semi-automatic means of replying
-;; to unsolicited commercial email (UCE) you might get. Currently, it
-;; only works with Rmail and Gnus. If you would like to make it work
-;; with other mail readers, see the mail-client dependent section of
-;; uce-reply-to-uce. Please let me know about your changes so I can
-;; incorporate them. I'd appreciate it.
-
-;; -- !!! 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.
-;;
-;; -------------------------------------------------------------
-
-;; 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
-;; address of the sender (From, Reply-To lines), and puts these
-;; addresses into the To: header, along with abuse@offenders.host; 2)
-;; the mailhub that first saw this message, and adds the address of
-;; its postmaster into the To: header; and 3), finally, it looks at
-;; the Message-Id and adds the postmaster of that host to the list of
-;; addresses.
-
-;; Then, we add an "Errors-To: nobody@localhost" header, so that if
-;; some of these addresses are not actually correct, we will never see
-;; bounced mail. Also, mail-self-blind and mail-archive-file-name
-;; take no effect: the ideology is that we don't want to save junk or
-;; replies to junk.
-
-;; Then we insert a template into the buffer (a customizable message
-;; that explains what has happened), customizable signature, and the
-;; original message with full headers and envelope for postmasters.
-;; Then the buffer is left for editing.
-
-;; The reason that the function uce-reply-to-uce is mail-client
-;; dependent is that we want the full headers of the original message,
-;; nothing stripped. If we use the normal means of inserting the
-;; original message into the *mail* buffer, headers like Received:
-;; (not really headers, but envelope lines) will be stripped, while
-;; they bear valuable information for us and postmasters. I do wish
-;; that there would be some portable way to write this function, but I
-;; am not aware of any.
-
-;; Usage:
-
-;; Place uce.el in your load-path (and optionally byte-compile it).
-;; Add the following line to your init file:
-;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
-;; If you want to use it with Gnus rather than Rmail:
-;; (setq uce-mail-reader 'gnus)
-
-;; Options:
-
-;; uce-message-text is a template that will be inserted into buffer.
-;; It has a reasonable default. If you want to write some scarier
-;; one, please do so and send it to me. Please keep it polite.
-
-;; uce-signature behaves just like mail-signature. If nil, nothing is
-;; inserted, if t, file ~/.signature is used, if a string, its
-;; contents are inserted into buffer.
-
-;; uce-uce-separator is a line that separates your message from the
-;; UCE that you enclose.
-
-;; uce-subject-line will be used as the subject of the outgoing message.
-
-
-;;; Change Log:
-
-;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs
-
-;; Dec 11, 1996 -- fixed some typos, and Francesco Potortì
-;; <F.Potorti@cnuce.cnr.it> pointed out that my use of defvar was
-;; weird, suggested fix, and added let form.
-
-;; Dec 17, 1996 -- made scanning for host names little bit more clever
-;; (obviously bogus stuff like localhost is now ignored).
-
-;; Nov 11, 1997 -- incorporated changes from Mikael Djurfeldt
-;; <mdj@nada.kth.se> to make uce.el work with Gnus. Changed the text
-;; of message that is sent.
-
-;; Dec 3, 1997 -- changes from Gareth Jones <gdj1@gdjones.demon.co.uk>
-;; handling Received headers following some line like `From:'.
-
-;; Aug 16, 2000 -- changes from Detlev Zundel
-;; <detlev.zundel@stud.uni-karlsruhe.de> to make uce.el work with the
-;; latest Gnus. Lars told him it should work for all versions of Gnus
-;; younger than three years.
-
-
-;;; Code:
-
-(defvar gnus-original-article-buffer)
-(defvar mail-reply-buffer)
-
-(require 'sendmail)
-;; Those sections of code which are dependent upon
-;; RMAIL are only evaluated if we have received a message with RMAIL...
-;;(require 'rmail)
-
-(defgroup uce nil
- "Facilitate reply to unsolicited commercial email."
- :prefix "uce-"
- :group 'mail)
-
-(defcustom uce-mail-reader 'rmail
- "A symbol indicating which mail reader you are using.
-Choose from: `gnus', `rmail'."
- :type '(choice (const gnus) (const rmail))
- :version "20.3")
-
-(defcustom uce-setup-hook nil
- "Hook to run after UCE rant message is composed.
-This hook is run after `mail-setup-hook', which is run as well."
- :type 'hook)
-
-(defcustom uce-message-text
- "Recently, I have received an Unsolicited Commercial E-mail from you.
-I do not like UCE's and I would like to inform you that sending
-unsolicited messages to someone while he or she may have to pay for
-reading your message may be illegal. Anyway, it is highly annoying
-and not welcome by anyone. It is rude, after all.
-
-If you think that this is a good way to advertise your products or
-services you are mistaken. Spamming will only make people hate you, not
-buy from you.
-
-If you have any list of people you send unsolicited commercial emails to,
-REMOVE me from such list immediately. I suggest that you make this list
-just empty.
-
- ----------------------------------------------------
-
-If you are not an administrator of any site and still have received
-this message then your email address is being abused by some spammer.
-They fake your address in From: or Reply-To: header. In this case,
-you might want to show this message to your system administrator, and
-ask him/her to investigate this matter.
-
-Note to the postmaster(s): I append the text of UCE in question to
-this message; I would like to hear from you about action(s) taken.
-This message has been sent to postmasters at the host that is
-mentioned as original sender's host (I do realize that it may be
-faked, but I think that if your domain name is being abused this way
-you might want to learn about it, and take actions) and to the
-postmaster whose host was used as mail relay for this message. If
-message was sent not by your user, could you please compare time when
-this message was sent (use time in Received: field of the envelope
-rather than Date: field) with your sendmail logs and see what host was
-using your sendmail at this moment of time.
-
-Thank you."
-
- "This is the text that `uce-reply-to-uce' command will put in reply buffer.
-Some of spamming programs in use will be set up to read all incoming
-to spam address email, and will remove people who put the word `remove'
-on beginning of some line from the spamming list. So, when you set it
-up, it might be a good idea to actually use this feature.
-
-Value nil means insert no text by default, lets you type it in."
- :type '(choice (const nil) string))
-
-(defcustom uce-uce-separator
- "----- original unsolicited commercial email follows -----"
- "Line that will begin quoting of the UCE.
-Value nil means use no separator."
- :type '(choice (const nil) string))
-
-(defcustom uce-signature mail-signature
-"Text to put as your signature after the note to UCE sender.
-Value nil means none, t means insert `~/.signature' file (if it happens
-to exist), if this variable is a string this string will be inserted
-as your signature."
- :type '(choice (const nil) (const t) string))
-
-(defcustom uce-default-headers
- "Errors-To: nobody@localhost\nPrecedence: bulk\n"
- "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce].
-These are mostly meant for headers that prevent delivery errors reporting."
- :type '(choice (const nil) string))
-
-(defcustom uce-subject-line
- "Spam alert: unsolicited commercial e-mail"
- "Subject of the message that will be sent in response to a UCE."
- :type 'string)
-
-;; End of user options.
-
-
-(defvar rmail-buffer)
-(declare-function rmail-msg-is-pruned "rmail" ())
-(declare-function mail-strip-quoted-names "mail-utils" (address))
-(declare-function rmail-maybe-set-message-counters "rmail" ())
-(declare-function rmail-toggle-header "rmail" (&optional arg))
-
-;;;###autoload
-(defun uce-reply-to-uce (&optional _ignored)
- "Compose a reply to unsolicited commercial email (UCE).
-Sets up a reply buffer addressed to: the sender, his postmaster,
-his abuse@ address, and the postmaster of the mail relay used.
-You might need to set `uce-mail-reader' before using this."
- (interactive)
- ;; Start of mail-client dependent section.
- (let ((message-buffer
- (cond ((eq uce-mail-reader 'gnus) gnus-original-article-buffer)
- ((eq uce-mail-reader 'rmail) (bound-and-true-p rmail-buffer))
- (t (error
- "Variable uce-mail-reader set to unrecognized value"))))
- pruned)
- (or (and message-buffer (get-buffer message-buffer))
- (error "No mail buffer, cannot find UCE"))
- (switch-to-buffer message-buffer)
- ;; We need the message with headers pruned.
- ;; Why? All we do is get the from and reply-to headers. ?
- (and (eq uce-mail-reader 'rmail)
- (not (setq pruned (rmail-msg-is-pruned)))
- (rmail-toggle-header 1))
- (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
- (reply-to (mail-fetch-field "reply-to"))
- temp)
- ;; Initial setting of the list of recipients of our message; that's
- ;; what they are pretending to be.
- (setq to (if to
- (format "%s" (mail-strip-quoted-names to))
- ""))
- (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-search "@" to)
- end-of-hostname (string-match "[ ,>]" to first-at-sign)
- sender-host (substring to first-at-sign end-of-hostname))
- (if (string-search "." sender-host)
- (setq to (format "%s, postmaster%s, abuse%s"
- to sender-host sender-host))))
- (setq mail-send-actions nil)
- (setq mail-reply-buffer nil)
- (when (eq uce-mail-reader 'rmail)
- (rmail-toggle-header 0)
- (rmail-maybe-set-message-counters)) ; why?
- (copy-region-as-kill (point-min) (point-max))
- ;; Restore the initial header state we found.
- (and pruned (rmail-toggle-header 1))
- (switch-to-buffer "*mail*")
- (erase-buffer)
- (yank)
- (goto-char (point-min))
- ;; Delete any internal Rmail headers.
- (when (eq uce-mail-reader 'rmail)
- (search-forward "\n\n")
- (while (re-search-backward "^X-RMAIL" nil t)
- (delete-region (point) (line-beginning-position 2)))
- (goto-char (point-min)))
- ;; Now find the mail hub that first accepted this message.
- ;; This should try to find the last Received: header.
- ;; Sometimes there may be other headers in between Received: headers.
- (cond ((eq uce-mail-reader 'gnus)
- ;; Does Gnus always have Lines: in the end?
- (re-search-forward "^Lines:")
- (beginning-of-line))
- ((eq uce-mail-reader 'rmail)
- (search-forward "\n\n")))
- (re-search-backward "^Received:")
- ;; Is this always good? It's the only thing I saw when I checked
- ;; a few messages.
- ;;(if (not (re-search-forward ": \\(from\\|by\\) " eol t))
- (unless (re-search-forward "\\(from\\|by\\) " (line-end-position) 'move)
- (if (looking-at "[ \t\n]+\\(from\\|by\\) ")
- (goto-char (match-end 0))
- (error "Failed to extract hub address")))
- (setq temp (point))
- (search-forward " ")
- (forward-char -1)
- ;; And add its postmaster to the list of addresses.
- (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.
- (and (search-forward "\nMessage-Id: " nil t)
- ;; Not all Message-Id:'s have an `@' sign.
- (search-forward "@" (line-end-position) t)
- (progn
- (setq temp (point))
- (search-forward ">")
- (forward-char -1)
- (if (string-search "." (buffer-substring temp (point)))
- (setq to (format "%s, postmaster@%s"
- to (buffer-substring temp (point)))))))
- (when (eq uce-mail-reader 'gnus)
- ;; Does Gnus always have Lines: in the end?
- (re-search-forward "^Lines:")
- (beginning-of-line)
- (setq temp (point))
- (search-forward "\n\n" nil t)
- (forward-line -1)
- (delete-region temp (point)))
- ;; End of mail-client dependent section.
- (auto-save-mode auto-save-default)
- (mail-mode)
- (goto-char (point-min))
- (insert "To: ")
- (save-excursion
- (if to
- (let ((fill-prefix "\t")
- (address-start (point)))
- (insert to "\n")
- (fill-region-as-paragraph address-start (point)))
- (newline))
- (insert "Subject: " uce-subject-line "\n")
- (if uce-default-headers
- (insert uce-default-headers))
- (if mail-default-headers
- (insert mail-default-headers))
- (if mail-default-reply-to
- (insert "Reply-To: " mail-default-reply-to "\n"))
- (insert mail-header-separator "\n")
- ;; Insert all our text. Then go back to the place where we started.
- (if to (setq to (point)))
- ;; Text of ranting.
- (if uce-message-text
- (insert uce-message-text))
- ;; Signature.
- (cond ((eq uce-signature t)
- (if (file-exists-p "~/.signature")
- (progn
- (insert "\n\n-- \n")
- (forward-char (cadr (insert-file-contents "~/.signature"))))))
- (uce-signature
- (insert "\n\n-- \n" uce-signature)))
- ;; And text of the original message.
- (if uce-uce-separator
- (insert "\n\n" uce-uce-separator "\n"))
- ;; If message doesn't end with a newline, insert it.
- (goto-char (point-max))
- (or (bolp) (newline)))
- ;; And go back to the beginning of text.
- (if to (goto-char to))
- (or to (set-buffer-modified-p nil))
- ;; 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))))
-
-(defun uce-insert-ranting (&optional _ignored)
- "Insert text of the usual reply to UCE into current buffer."
- (interactive "P")
- (insert uce-message-text))
-
-(provide 'uce)
-
-;;; uce.el ends here
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
index 03e77a83ce3..cdb1bec4788 100644
--- a/lisp/mail/undigest.el
+++ b/lisp/mail/undigest.el
@@ -41,7 +41,8 @@ You may need to customize it for local needs."
(defconst rmail-digest-methods
- '(rmail-digest-parse-mime
+ '(rmail-digest-parse-mixed-mime
+ rmail-digest-parse-mime
rmail-digest-parse-rfc1153strict
rmail-digest-parse-rfc1153sloppy
rmail-digest-parse-rfc934)
@@ -52,6 +53,53 @@ A function returns nil if it cannot parse the digest. If it can, it
returns a list of cons pairs containing the start and end positions of
each undigestified message as markers.")
+(defun rmail-content-type-boundary (type)
+ "If Content-type is of type TYPE, return its boundary; otherwise, return nil."
+ (goto-char (point-min))
+ (let ((head-end (save-excursion (search-forward "\n\n" nil t) (point))))
+ (when (re-search-forward
+ (concat "^Content-type: " type ";"
+ "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]")
+ head-end t)
+ (match-string 1))))
+
+(defun rmail-digest-parse-mixed-mime ()
+ "Like `rmail-digest-parse-mime', but for multipart/mixed messages."
+ (when-let ((boundary (rmail-content-type-boundary "multipart/mixed")))
+ (let ((global-sep (concat "\n--" boundary))
+ (digest (concat "^Content-type: multipart/digest;"
+ "\\s-* boundary=\"?\\([^\";\n]+\\)[\";\n]"))
+ result)
+ (search-forward global-sep nil t)
+ (while (not (or result (eobp)))
+ ;; For each part, see if it is a multipart/digest.
+ (let* ((limit (save-excursion (search-forward global-sep nil 'move)
+ (point)))
+ (beg (and (re-search-forward digest limit t)
+ (match-beginning 0)))
+ digest-sep)
+ (when (and beg
+ (setq digest-sep (concat "\n--" (match-string 1)))
+ ;; Search for 1st sep.
+ (search-forward digest-sep nil t))
+ ;; Skip body part headers.
+ (search-forward "\n\n" nil t)
+ ;; Push the 1st message.
+ (push (cons (copy-marker beg) (copy-marker (point-marker) t))
+ result)
+ ;; Push the rest of the messages.
+ (let ((start (make-marker))
+ done)
+ (while (and (search-forward digest-sep limit 'move) (not done))
+ (move-marker start (match-beginning 0))
+ (and (looking-at "--$") (setq done t))
+ (search-forward "\n\n")
+ (push (cons (copy-marker start)
+ (copy-marker (point-marker) t))
+ result))))
+ (goto-char limit)))
+ (nreverse result))))
+
(defun rmail-digest-parse-mime ()
(goto-char (point-min))
(when (let ((head-end (progn (search-forward "\n\n" nil t) (point))))
@@ -330,8 +378,4 @@ forwarded with `rmail-enable-mime-composing' set to nil."
(provide 'undigest)
-;; Local Variables:
-;; generated-autoload-file: "rmail-loaddefs.el"
-;; End:
-
;;; undigest.el ends here
diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el
index 8ce5afa9622..9e7194e4a02 100644
--- a/lisp/mail/unrmail.el
+++ b/lisp/mail/unrmail.el
@@ -208,7 +208,7 @@ The variable `unrmail-mbox-format' controls which mbox format to use."
(setq mail-from (or (let ((from (mail-fetch-field "Mail-From")))
;; mail-mbox-from (below) returns a
;; string that ends in a newline, but
- ;; but mail-fetch-field does not, so
+ ;; mail-fetch-field does not, so
;; we append a newline here.
(if from
(format "%s\n" from)))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-09 10:19:37 +0000