summaryrefslogtreecommitdiff
path: root/lisp/mail
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/mail')
-rw-r--r--lisp/mail/emacsbug.el10
-rw-r--r--lisp/mail/feedmail.el25
-rw-r--r--lisp/mail/footnote.el2
-rw-r--r--lisp/mail/ietf-drums-date.el274
-rw-r--r--lisp/mail/ietf-drums.el50
-rw-r--r--lisp/mail/mail-parse.el3
-rw-r--r--lisp/mail/mail-utils.el15
-rw-r--r--lisp/mail/rfc2047.el2
-rw-r--r--lisp/mail/rmail.el19
-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.el22
-rw-r--r--lisp/mail/smtpmail.el8
-rw-r--r--lisp/mail/supercite.el2
-rw-r--r--lisp/mail/uce.el51
-rw-r--r--lisp/mail/undigest.el50
21 files changed, 444 insertions, 160 deletions
diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el
index 1bda609d105..df2b7a7453b 100644
--- a/lisp/mail/emacsbug.el
+++ b/lisp/mail/emacsbug.el
@@ -488,7 +488,14 @@ 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)
@@ -509,6 +516,7 @@ Message buffer where you can explain more about the patch."
(view-mode 1)
(button-mode 1))
(message-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")
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/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-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..952970d07c0 100644
--- a/lisp/mail/mail-utils.el
+++ b/lisp/mail/mail-utils.el
@@ -368,19 +368,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/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..adb61aa09db 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))
@@ -539,7 +537,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)
@@ -4125,10 +4123,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 +4132,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 +4489,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 +4592,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..c55cdc8412a 100644
--- a/lisp/mail/sendmail.el
+++ b/lisp/mail/sendmail.el
@@ -877,7 +877,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 +955,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)
@@ -1391,8 +1395,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 +1411,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))
diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el
index 8ac0cd7e7c0..88e55e968c4 100644
--- a/lisp/mail/smtpmail.el
+++ b/lisp/mail/smtpmail.el
@@ -554,11 +554,9 @@ for `smtpmail-try-auth-method'.")
: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,9 +571,7 @@ 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)))
+ password (auth-info-password auth-info)))
(let ((result (catch 'done
(if (and mech user password)
(smtpmail-try-auth-method process mech user password)
diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el
index b56ceed2cc0..5dc5ee38ffd 100644
--- a/lisp/mail/supercite.el
+++ b/lisp/mail/supercite.el
@@ -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
index 9e367dc6349..2672cfca1fb 100644
--- a/lisp/mail/uce.el
+++ b/lisp/mail/uce.el
@@ -30,26 +30,8 @@
;; 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.
-;;
-;; -------------------------------------------------------------
+;; 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
@@ -234,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).
@@ -379,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 03e77a83ce3..c6d29bc4e77 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))))
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-09 04:53:23 +0000