diff options
Diffstat (limited to 'lisp/mail')
34 files changed, 587 insertions, 457 deletions
diff --git a/lisp/mail/binhex.el b/lisp/mail/binhex.el index edb52b65789..af327442c28 100644 --- a/lisp/mail/binhex.el +++ b/lisp/mail/binhex.el @@ -38,19 +38,16 @@ "Non-nil value should be a string that names a binhex decoder. The program should expect to read binhex data on its standard input and write the converted data to its standard output." - :type 'string - :group 'binhex) + :type 'string) (defcustom binhex-decoder-switches '("-d") "List of command line flags passed to the command `binhex-decoder-program'." - :group 'binhex :type '(repeat string)) (defcustom binhex-use-external (executable-find binhex-decoder-program) "Use external binhex program." :version "22.1" - :group 'binhex :type 'boolean) (defconst binhex-alphabet-decoding-alist @@ -80,7 +77,7 @@ input and write the converted data to its standard output." (make-obsolete-variable 'binhex-temporary-file-directory 'temporary-file-directory "28.1") -(defun binhex-insert-char (char &optional count ignored buffer) +(defun binhex-insert-char (char &optional count _ignored buffer) "Insert COUNT copies of CHARACTER into BUFFER." (if (or (null buffer) (eq buffer (current-buffer))) (insert-char char count) @@ -273,7 +270,8 @@ If HEADER-ONLY is non-nil only decode header and return filename." (defun binhex-decode-region-external (start end) "Binhex decode region between START and END using external decoder." (interactive "r") - (let ((cbuf (current-buffer)) firstline work-buffer + (let ((cbuf (current-buffer)) + work-buffer ;; firstline (file-name (expand-file-name (concat (binhex-decode-region-internal start end t) ".data") @@ -287,9 +285,9 @@ If HEADER-ONLY is non-nil only decode header and return filename." (set-buffer (setq work-buffer (generate-new-buffer " *binhex-work*"))) (buffer-disable-undo work-buffer) - (insert-buffer-substring cbuf firstline end) + (insert-buffer-substring cbuf nil end) ;; firstline (cd temporary-file-directory) - (apply 'call-process-region + (apply #'call-process-region (point-min) (point-max) binhex-decoder-program diff --git a/lisp/mail/blessmail.el b/lisp/mail/blessmail.el index 505ce5d4767..f380f0df290 100644 --- a/lisp/mail/blessmail.el +++ b/lisp/mail/blessmail.el @@ -1,4 +1,4 @@ -;;; blessmail.el --- decide whether movemail needs special privileges -*- no-byte-compile: t -*- +;;; blessmail.el --- decide whether movemail needs special privileges -*- no-byte-compile: t; lexical-binding: t; -*- ;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 815ff4339eb..14c93f2fc8e 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -1,4 +1,4 @@ -;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list +;;; emacsbug.el --- command to report Emacs bugs to appropriate mailing list -*- lexical-binding: t; -*- ;; Copyright (C) 1985, 1994, 1997-1998, 2000-2021 Free Software ;; Foundation, Inc. @@ -45,12 +45,10 @@ (defcustom report-emacs-bug-no-confirmation nil "If non-nil, suppress the confirmations asked for the sake of novice users." - :group 'emacsbug :type 'boolean) (defcustom report-emacs-bug-no-explanations nil "If non-nil, suppress the explanations given for the sake of novice users." - :group 'emacsbug :type 'boolean) ;; User options end here. @@ -204,7 +202,7 @@ This requires either the macOS \"open\" command, or the freedesktop (defvar message-sendmail-envelope-from) ;;;###autoload -(defun report-emacs-bug (topic &optional unused) +(defun report-emacs-bug (topic &optional _unused) "Report a bug in GNU Emacs. Prompts for bug subject. Leaves you in a mail buffer. @@ -219,10 +217,10 @@ Already submitted bugs can be found in the Emacs bug tracker: (let ((from-buffer (current-buffer)) (can-insert-mail (or (report-emacs-bug-can-use-xdg-email) (report-emacs-bug-can-use-osx-open))) - user-point message-end-point) - (setq message-end-point - (with-current-buffer (messages-buffer) - (point-max-marker))) + user-point) ;; message-end-point + ;; (setq message-end-point + ;; (with-current-buffer (messages-buffer) + ;; (point-max-marker))) (condition-case nil ;; For the novice user make sure there's always enough space for ;; the mail and the warnings buffer on this frame (Bug#10873). @@ -263,7 +261,7 @@ Already submitted bugs can be found in the Emacs bug tracker: "Bug-GNU-Emacs" 'face 'link 'help-echo (concat "mouse-2, RET: Follow this link") - 'action (lambda (button) + 'action (lambda (_button) (browse-url "https://lists.gnu.org/r/bug-gnu-emacs/")) 'follow-link t) (insert " mailing list\nand the GNU bug tracker at ") @@ -271,7 +269,7 @@ Already submitted bugs can be found in the Emacs bug tracker: "debbugs.gnu.org" 'face 'link 'help-echo (concat "mouse-2, RET: Follow this link") - 'action (lambda (button) + 'action (lambda (_button) (browse-url "https://debbugs.gnu.org/cgi/pkgreport.cgi?package=emacs;max-bugs=100;base-order=1;bug-rev=1")) 'follow-link t) @@ -311,7 +309,7 @@ usually do not have translators for other languages.\n\n"))) (lambda (var) (let ((val (getenv var))) (if val (insert (format " value of $%s: %s\n" var val))))) - '("EMACSDATA" "EMACSDOC" "EMACSLOADPATH" "EMACSPATH" + '("EMACSDATA" "EMACSDOC" "EMACSLOADPATH" "EMACSNATIVELOADPATH" "EMACSPATH" "LC_ALL" "LC_COLLATE" "LC_CTYPE" "LC_MESSAGES" "LC_MONETARY" "LC_NUMERIC" "LC_TIME" "LANG" "XMODIFIERS")) (insert (format " locale-coding-system: %s\n" locale-coding-system)) @@ -347,10 +345,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) + (define-key (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)) + #'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 @@ -376,7 +374,7 @@ usually do not have translators for other languages.\n\n"))) (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 - (add-hook report-emacs-bug-send-hook 'report-emacs-bug-hook nil t)) + (add-hook report-emacs-bug-send-hook #'report-emacs-bug-hook nil t)) (goto-char (point-max)) (skip-chars-backward " \t\n") (setq-local report-emacs-bug-orig-text @@ -398,7 +396,7 @@ usually do not have translators for other languages.\n\n"))) ;; This is used not only for X11 but also W32 and others. (insert "Windowing system distributor '" (x-server-vendor) "', version " - (mapconcat 'number-to-string (x-server-version) ".") "\n") + (mapconcat #'number-to-string (x-server-version) ".") "\n") (error t))) (let ((os (ignore-errors (report-emacs-bug--os-description)))) (if (stringp os) @@ -409,7 +407,7 @@ usually do not have translators for other languages.\n\n"))) system-configuration-options "'\n\n") (fill-region (line-beginning-position -1) (point)))) -(define-obsolete-function-alias 'report-emacs-bug-info 'info-emacs-bug "24.3") +(define-obsolete-function-alias 'report-emacs-bug-info #'info-emacs-bug "24.3") (defun report-emacs-bug-hook () "Do some checking before sending a bug report." diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 2bcbdf4a223..cec573642ec 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -163,7 +163,7 @@ ;; (autoload 'feedmail-buffer-to-smtpmail "feedmail" nil t) ;; (setq feedmail-buffer-eating-function 'feedmail-buffer-to-smtpmail) ;; -;; Alternatively, the FLIM <http://www.m17n.org/FLIM/> project +;; Alternatively, the FLIM <https://www.m17n.org/FLIM/> project ;; provides a library called smtp.el. If you want to use that, the above lines ;; would be: ;; @@ -1381,7 +1381,7 @@ It shows the simple addresses and gets a confirmation. Use as: (save-window-excursion (display-buffer (set-buffer (get-buffer-create " F-C-A-H-E"))) (erase-buffer) - (insert (mapconcat 'identity feedmail-address-list " ")) + (insert (mapconcat #'identity feedmail-address-list " ")) (if (not (y-or-n-p "How do you like them apples? ")) (error "FQM: Sending...gave up in last chance hook")))) @@ -1592,10 +1592,10 @@ Feeds the buffer to it." (feedmail-say-debug ">in-> feedmail-buffer-to-binmail %s" addr-listoid) (set-buffer prepped) (apply - 'call-process-region + #'call-process-region (append (list (point-min) (point-max) "/bin/sh" nil errors-to nil "-c" (format feedmail-binmail-template - (mapconcat 'identity addr-listoid " ")))))) + (mapconcat #'identity addr-listoid " ")))))) (defvar sendmail-program) @@ -1609,7 +1609,7 @@ local gurus." (require 'sendmail) (feedmail-say-debug ">in-> feedmail-buffer-to-sendmail %s" addr-listoid) (set-buffer prepped) - (apply 'call-process-region + (apply #'call-process-region (append (list (point-min) (point-max) sendmail-program nil errors-to nil "-oi" "-t") ;; provide envelope "from" to sendmail; results will vary @@ -2042,7 +2042,7 @@ backup file names and the like)." (message "FQM: Trapped `%s', message left in queue." (car signal-stuff)) (sit-for 3) (message "FQM: Trap details: \"%s\"" - (mapconcat 'identity (cdr signal-stuff) "\" \"")) + (mapconcat #'identity (cdr signal-stuff) "\" \"")) (sit-for 3))) (kill-buffer blobby-buffer) (feedmail-say-chatter diff --git a/lisp/mail/flow-fill.el b/lisp/mail/flow-fill.el index 0fab1b21b47..5319ab994ce 100644 --- a/lisp/mail/flow-fill.el +++ b/lisp/mail/flow-fill.el @@ -81,7 +81,7 @@ RFC 2646 suggests 66 characters for readability." (while (setq end (text-property-any start (point-max) 'hard 't)) (save-restriction (narrow-to-region start end) - (let ((fill-column (eval fill-flowed-encode-column))) + (let ((fill-column (eval fill-flowed-encode-column t))) (fill-flowed-fill-buffer)) (goto-char (point-min)) (while (re-search-forward "\n" nil t) @@ -119,7 +119,7 @@ If BUFFER is nil, default to the current buffer. If DELETE-SPACE, delete RFC2646 spaces padding at the end of lines." (with-current-buffer (or buffer (current-buffer)) - (let ((fill-column (eval fill-flowed-display-column))) + (let ((fill-column (eval fill-flowed-display-column t))) (goto-char (point-min)) (while (not (eobp)) (cond diff --git a/lisp/mail/ietf-drums.el b/lisp/mail/ietf-drums.el index 795e37dced6..b1682cf78a2 100644 --- a/lisp/mail/ietf-drums.el +++ b/lisp/mail/ietf-drums.el @@ -232,13 +232,13 @@ If DECODE, the DISPLAY-NAME will have RFC2047 decoding performed ;; If we found no display-name, then we look for comments. (if display-name (setq display-string - (mapconcat 'identity (reverse display-name) " ")) + (mapconcat #'identity (reverse display-name) " ")) (setq display-string (ietf-drums-get-comment string))) (if (not mailbox) (when (and display-string - (string-match "@" display-string)) + (string-search "@" display-string)) (cons - (mapconcat 'identity (nreverse display-name) "") + (mapconcat #'identity (nreverse display-name) "") (ietf-drums-get-comment string))) (cons mailbox (if decode (rfc2047-decode-string display-string) diff --git a/lisp/mail/mail-extr.el b/lisp/mail/mail-extr.el index 4e3bf78c807..24d8311f641 100644 --- a/lisp/mail/mail-extr.el +++ b/lisp/mail/mail-extr.el @@ -1,4 +1,4 @@ -;;; mail-extr.el --- extract full name and address from email header +;;; mail-extr.el --- extract full name and address from email header -*- lexical-binding: t; -*- ;; Copyright (C) 1991-1994, 1997, 2001-2021 Free Software Foundation, ;; Inc. @@ -222,23 +222,20 @@ "Whether to try to guess middle initial from mail address. If true, then when we see an address like \"John Smith <jqs@host.com>\" we will assume that \"John Q. Smith\" is the fellow's name." - :type 'boolean - :group 'mail-extr) + :type 'boolean) (defcustom mail-extr-ignore-single-names nil "Whether to ignore a name that is just a single word. If true, then when we see an address like \"Idiot <dumb@stupid.com>\" we will act as though we couldn't find a full name in the address." :type 'boolean - :version "22.1" - :group 'mail-extr) + :version "22.1") (defcustom mail-extr-ignore-realname-equals-mailbox-name t "Whether to ignore a name that is equal to the mailbox name. If true, then when the address is like \"Single <single@address.com>\" we will act as though we couldn't find a full name in the address." - :type 'boolean - :group 'mail-extr) + :type 'boolean) ;; Matches a leading title that is not part of the name (does not ;; contribute to uniquely identifying the person). @@ -248,19 +245,16 @@ we will act as though we couldn't find a full name in the address." "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." - :type 'regexp - :group 'mail-extr) + :type 'regexp) (defcustom mail-extr-@-binds-tighter-than-! nil "Whether the local mail transport agent looks at ! before @." - :type 'boolean - :group 'mail-extr) + :type 'boolean) (defcustom mail-extr-mangle-uucp nil "Whether to throw away information in UUCP addresses by translating things like \"foo!bar!baz@host\" into \"baz@bar.UUCP\"." - :type 'boolean - :group 'mail-extr) + :type 'boolean) ;;---------------------------------------------------------------------- ;; what orderings are meaningful????? @@ -713,7 +707,10 @@ This function is primarily meant for when you're displaying the result to the user: Many prettifications are applied to the result returned. If you want to decode an address for further non-display use, you should probably use -`mail-header-parse-address' instead." +`mail-header-parse-address' instead. Also see +`mail-header-parse-address-lax' for a function that's less strict +than `mail-header-parse-address', but does less post-processing +to the results." (let ((canonicalization-buffer (get-buffer-create " *canonical address*")) (extraction-buffer (get-buffer-create " *extract address components*")) value-list) @@ -760,7 +757,6 @@ non-display use, you should probably use end-of-address <-pos >-pos @-pos colon-pos comma-pos !-pos %-pos \;-pos group-:-pos group-\;-pos route-addr-:-pos - record-pos-symbol first-real-pos last-real-pos phrase-beg phrase-end ;; Dynamically set in mail-extr-voodoo. @@ -852,13 +848,16 @@ non-display use, you should probably use ) ;; record the position of various interesting chars, determine ;; validity later. - ((setq record-pos-symbol - (cdr (assq char - '((?< . <-pos) (?> . >-pos) (?@ . @-pos) - (?: . colon-pos) (?, . comma-pos) (?! . !-pos) - (?% . %-pos) (?\; . \;-pos))))) - (set record-pos-symbol - (cons (point) (symbol-value record-pos-symbol))) + ((memq char '(?< ?> ?@ ?: ?, ?! ?% ?\;)) + (push (point) (pcase-exhaustive char + (?< <-pos) + (?> >-pos) + (?@ @-pos) + (?: colon-pos) + (?, comma-pos) + (?! !-pos) + (?% %-pos) + (?\; \;-pos))) (forward-char 1)) ((eq char ?.) (forward-char 1)) @@ -1065,7 +1064,7 @@ non-display use, you should probably use (mail-extr-demarkerize route-addr-:-pos) (setq route-addr-:-pos nil >-pos (mail-extr-demarkerize >-pos) - %-pos (mapcar 'mail-extr-demarkerize %-pos))) + %-pos (mapcar #'mail-extr-demarkerize %-pos))) ;; de-listify @-pos (setq @-pos (car @-pos)) @@ -1122,7 +1121,7 @@ non-display use, you should probably use (setq insert-point (point-max))) (%-pos (setq insert-point (car (last %-pos)) - saved-%-pos (mapcar 'mail-extr-markerize %-pos) + saved-%-pos (mapcar #'mail-extr-markerize %-pos) %-pos nil @-pos (mail-extr-markerize @-pos))) (@-pos @@ -1162,7 +1161,7 @@ non-display use, you should probably use "uucp")) (setq !-pos (cdr !-pos)))) (and saved-%-pos - (setq %-pos (append (mapcar 'mail-extr-demarkerize + (setq %-pos (append (mapcar #'mail-extr-demarkerize saved-%-pos) %-pos))) (setq @-pos (mail-extr-demarkerize @-pos)) @@ -1461,8 +1460,7 @@ If it is neither nil nor a string, modifying of names will never take place. It affects how `mail-extract-address-components' works." :type '(choice (regexp :size 0) (const :tag "Always enabled" nil) - (const :tag "Always disabled" t)) - :group 'mail-extr) + (const :tag "Always disabled" t))) (defun mail-extr-voodoo (mbox-beg mbox-end canonicalization-buffer) (unless (and mail-extr-disable-voodoo @@ -2241,13 +2239,13 @@ place. It affects how `mail-extract-address-components' works." ;(let ((all nil)) -; (mapatoms #'(lambda (x) +; (mapatoms (lambda (x) ; (if (and (boundp x) ; (string-match "^mail-extr-" (symbol-name x))) ; (setq all (cons x all))))) ; (setq all (sort all #'string-lessp)) ; (cons 'setq -; (apply 'nconc (mapcar #'(lambda (x) +; (apply 'nconc (mapcar (lambda (x) ; (list x (symbol-value x))) ; all)))) diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el index 37c8ad68860..239b386ff84 100644 --- a/lisp/mail/mail-hist.el +++ b/lisp/mail/mail-hist.el @@ -1,4 +1,4 @@ -;;; mail-hist.el --- headers and message body history for outgoing mail +;;; mail-hist.el --- headers and message body history for outgoing mail -*- lexical-binding: t; -*- ;; Copyright (C) 1994, 2001-2021 Free Software Foundation, Inc. @@ -69,8 +69,8 @@ ;;;###autoload (defun mail-hist-enable () - (add-hook 'mail-mode-hook 'mail-hist-define-keys) - (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history)) + (add-hook 'mail-mode-hook #'mail-hist-define-keys) + (add-hook 'mail-send-hook #'mail-hist-put-headers-into-history)) (defvar mail-hist-header-ring-alist nil "Alist of form (header-name . history-ring). @@ -80,14 +80,12 @@ 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 - :group 'mail-hist) + :type 'integer) ;;;###autoload (defcustom mail-hist-keep-history t "Non-nil means keep a history for headers and text of outgoing mail." - :type 'boolean - :group 'mail-hist) + :type 'boolean) ;; For handling repeated history requests (defvar mail-hist-access-count 0) @@ -184,8 +182,7 @@ HEADER is a string without the colon." (defcustom mail-hist-text-size-limit nil "Don't store any header or body with more than this many characters. If the value is nil, that means no limit on text size." - :type '(choice (const nil) integer) - :group 'mail-hist) + :type '(choice (const nil) integer)) (defun mail-hist-text-too-long-p (text) "Return non-nil if TEXT's length exceeds `mail-hist-text-size-limit'." diff --git a/lisp/mail/mail-parse.el b/lisp/mail/mail-parse.el index e72ed828494..212fadf3823 100644 --- a/lisp/mail/mail-parse.el +++ b/lisp/mail/mail-parse.el @@ -71,6 +71,45 @@ (defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region) (defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string) +(defun mail-header-parse-addresses-lax (string) + "Parse STRING as a comma-separated list of mail addresses. +The return value is a list with mail/name pairs." + (delq nil + (mapcar (lambda (elem) + (or (mail-header-parse-address elem) + (mail-header-parse-address-lax elem))) + (mail-header-parse-addresses string t)))) + +(defun mail-header-parse-address-lax (string) + "Parse STRING as a mail address. +Returns a mail/name pair. + +This function will first try to parse STRING as a +standards-compliant address string, and if that fails, try to use +heuristics to determine the email address and the name in the +string." + (with-temp-buffer + (insert (string-clean-whitespace string)) + ;; Find the bit with the @ and guess that that's the mail. + (goto-char (point-max)) + (when (search-backward "@" nil t) + (if (re-search-backward " " nil t) + (forward-char 1) + (goto-char (point-min))) + (let* ((start (point)) + (mail (buffer-substring + start (or (re-search-forward " " nil t) + (goto-char (point-max)))))) + (delete-region start (point)) + ;; We've now removed the email bit, so the rest of the stuff + ;; has to be the name. + (cons (string-trim mail "[<]+" "[>]+") + (let ((name (string-trim (buffer-string) + "[ \t\n\r(]+" "[ \t\n\r)]+"))) + (if (length= name 0) + nil + name))))))) + (provide 'mail-parse) ;;; mail-parse.el ends here diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index ad2dee59c7c..3eb3ccb93de 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -1,4 +1,4 @@ -;;; mail-utils.el --- utility functions used both by rmail and rnews +;;; mail-utils.el --- utility functions used both by rmail and rnews -*- lexical-binding: t -*- ;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc. @@ -46,6 +46,7 @@ also the To field, unless this would leave an empty To field." :type '(choice regexp (const :tag "Your Name" nil)) :group 'mail) +(defvar epa-inhibit) ;; Returns t if file FILE is an Rmail file. ;;;###autoload (defun mail-file-babyl-p (file) @@ -58,6 +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? (if (null end) (substring string 0 start) (concat (substring string 0 start) (substring string end nil)))) @@ -132,7 +134,7 @@ we expect to find and remove the wrapper characters =?ISO-8859-1?Q?....?=." (aref string (1+ (match-beginning 1)))))) strings))) (setq i (match-end 0))) - (apply 'concat (nreverse (cons (substring string i) strings)))))) + (apply #'concat (nreverse (cons (substring string i) strings)))))) ;; FIXME Gnus for some reason has `quoted-printable-decode-region' in qp.el. ;;;###autoload @@ -192,7 +194,7 @@ Also delete leading/trailing whitespace and replace FOO <BAR> with just BAR. Return a modified address list." (when address (if mail-use-rfc822 - (mapconcat 'identity (rfc822-addresses address) ", ") + (mapconcat #'identity (rfc822-addresses address) ", ") (let (pos) ;; Strip comments. @@ -250,7 +252,7 @@ comma-separated list, and return the pruned list." (setq cur-pos (string-match "[,\"]" destinations cur-pos)) (if (and cur-pos (equal (match-string 0 destinations) "\"")) ;; Search for matching quote. - (let ((next-pos (string-match "\"" destinations (1+ cur-pos)))) + (let ((next-pos (string-search "\"" destinations (1+ cur-pos)))) (if next-pos (setq cur-pos (1+ next-pos)) ;; If the open-quote has no close-quote, @@ -280,7 +282,7 @@ comma-separated list, and return the pruned list." destinations)) ;; Legacy name -(define-obsolete-function-alias 'rmail-dont-reply-to 'mail-dont-reply-to "24.1") +(define-obsolete-function-alias 'rmail-dont-reply-to #'mail-dont-reply-to "24.1") ;;;###autoload diff --git a/lisp/mail/mailabbrev.el b/lisp/mail/mailabbrev.el index 2147049ab19..5cb4a7469a9 100644 --- a/lisp/mail/mailabbrev.el +++ b/lisp/mail/mailabbrev.el @@ -1,4 +1,4 @@ -;;; mailabbrev.el --- abbrev-expansion of mail aliases +;;; mailabbrev.el --- abbrev-expansion of mail aliases -*- lexical-binding: t; -*- ;; Copyright (C) 1985-1987, 1992-1993, 1996-1997, 2000-2021 Free ;; Software Foundation, Inc. @@ -140,15 +140,13 @@ abbrev-like expansion is performed when editing certain mail headers (those specified by `mail-abbrev-mode-regexp'), based on the entries in your `mail-personal-alias-file'." :global t - :group 'mail-abbrev :version "20.3" (if mail-abbrevs-mode (mail-abbrevs-enable) (mail-abbrevs-disable))) (defcustom mail-abbrevs-only nil "Non-nil means only mail abbrevs should expand automatically. Other abbrevs expand only when you explicitly use `expand-abbrev'." - :type 'boolean - :group 'mail-abbrev) + :type 'boolean) ;; originally defined in sendmail.el - used to be an alist, now is a table. (defvar mail-abbrevs nil @@ -186,11 +184,11 @@ no aliases, which is represented by this being a table with no entries.)") (abbrev-mode 1)) (defun mail-abbrevs-enable () - (add-hook 'mail-mode-hook 'mail-abbrevs-setup)) + (add-hook 'mail-mode-hook #'mail-abbrevs-setup)) (defun mail-abbrevs-disable () "Turn off use of the `mailabbrev' package." - (remove-hook 'mail-mode-hook 'mail-abbrevs-setup) + (remove-hook 'mail-mode-hook #'mail-abbrevs-setup) (abbrev-mode (if (default-value 'abbrev-mode) 1 -1))) ;;;###autoload @@ -258,8 +256,7 @@ By default this is the file specified by `mail-personal-alias-file'." "String inserted between addresses in multi-address mail aliases. This has to contain a comma, so \", \" is a reasonable value. You might also want something like \",\\n \" to get each address on its own line." - :type 'string - :group 'mail-abbrev) + :type 'string) ;; define-mail-abbrev sets this flag, which causes mail-resolve-all-aliases ;; to be called before expanding abbrevs if it's necessary. @@ -367,7 +364,7 @@ double-quotes." (defun mail-resolve-all-aliases-1 (sym &optional so-far) (if (memq sym so-far) (error "mail alias loop detected: %s" - (mapconcat 'symbol-name (cons sym so-far) " <- "))) + (mapconcat #'symbol-name (cons sym so-far) " <- "))) (let ((definition (and (boundp sym) (symbol-value sym)))) (if definition (let ((result '()) @@ -420,8 +417,7 @@ of the current line; if it matches, abbrev mode will be turned on, otherwise it will be turned off. (You don't need to worry about continuation lines.) This should be set to match those mail fields in which you want abbreviations turned on." - :type 'regexp - :group 'mail-abbrev) + :type 'regexp) (defvar mail-abbrev-syntax-table nil "The syntax-table used for abbrev-expansion purposes. @@ -433,14 +429,14 @@ of a mail alias. The value is set up, buffer-local, when first needed.") (make-local-variable 'mail-abbrev-syntax-table) (unless mail-abbrev-syntax-table (let ((tab (copy-syntax-table (syntax-table))) - (_ (aref (standard-syntax-table) ?_)) + (syntax-_ (aref (standard-syntax-table) ?_)) (w (aref (standard-syntax-table) ?w))) (map-char-table (lambda (key value) (if (null value) ;; Fetch the inherited value (setq value (aref tab key))) - (if (equal value _) + (if (equal value syntax-_) (set-char-table-range tab key w))) tab) (modify-syntax-entry ?@ "w" tab) @@ -600,12 +596,12 @@ In other respects, this behaves like `end-of-buffer', which see." (eval-after-load "sendmail" '(progn - (define-key mail-mode-map "\C-c\C-a" 'mail-abbrev-insert-alias) + (define-key mail-mode-map "\C-c\C-a" #'mail-abbrev-insert-alias) (define-key mail-mode-map "\e\t" ; like completion-at-point - 'mail-abbrev-complete-alias))) + #'mail-abbrev-complete-alias))) ;; FIXME: Use `completion-at-point'. -;;(define-key mail-mode-map "\C-n" 'mail-abbrev-next-line) -;;(define-key mail-mode-map "\M->" 'mail-abbrev-end-of-buffer) +;;(define-key mail-mode-map "\C-n" #'mail-abbrev-next-line) +;;(define-key mail-mode-map "\M->" #'mail-abbrev-end-of-buffer) (provide 'mailabbrev) diff --git a/lisp/mail/mailclient.el b/lisp/mail/mailclient.el index 3cba6a60e8f..5c153ce1c1f 100644 --- a/lisp/mail/mailclient.el +++ b/lisp/mail/mailclient.el @@ -1,4 +1,4 @@ -;;; mailclient.el --- mail sending via system's mail client. +;;; mailclient.el --- mail sending via system's mail client. -*- lexical-binding: t; -*- ;; Copyright (C) 2005-2021 Free Software Foundation, Inc. diff --git a/lisp/mail/mailheader.el b/lisp/mail/mailheader.el index cbc01e4a442..0443279be84 100644 --- a/lisp/mail/mailheader.el +++ b/lisp/mail/mailheader.el @@ -1,4 +1,4 @@ -;;; mailheader.el --- mail header parsing, merging, formatting +;;; mailheader.el --- mail header parsing, merging, formatting -*- lexical-binding: t; -*- ;; Copyright (C) 1996, 2001-2021 Free Software Foundation, Inc. @@ -99,23 +99,23 @@ value." headers) ;; Advertised part of the interface; see mail-header, mail-header-set. -(with-suppressed-warnings ((lexical headers)) - (defvar headers)) -(defsubst mail-header (header &optional header-alist) +(defun mail-header (header &optional header-alist) "Return the value associated with header HEADER in HEADER-ALIST. If the value is a string, it is the original value of the header. If the value is a list, its first element is the original value of the header, -with any subsequent elements being the result of parsing the value. -If HEADER-ALIST is nil, the dynamically bound variable `headers' is used." +with any subsequent elements being the result of parsing the value." (declare (gv-setter (lambda (value) `(mail-header-set ,header ,value ,header-alist)))) + (with-suppressed-warnings ((lexical headers)) (defvar headers)) (cdr (assq header (or header-alist headers)))) (defun mail-header-set (header value &optional header-alist) "Set the value associated with header HEADER to VALUE in HEADER-ALIST. HEADER-ALIST defaults to the dynamically bound variable `headers' if nil. See `mail-header' for the semantics of VALUE." + (declare (obsolete alist-get "28.1")) + (with-suppressed-warnings ((lexical headers)) (defvar headers)) (let* ((alist (or header-alist headers)) (entry (assq header alist))) (if entry @@ -131,10 +131,13 @@ should be a string or a list of string. The first element may be nil to denote that the formatting functions must use the remaining elements, or skip the header altogether if there are no other elements. The macro `mail-header' can be used to access headers in HEADERS." - (mapcar - (lambda (rule) - (cons (car rule) (eval (cdr rule)))) - merge-rules)) + (declare (obsolete alist-get "28.1")) + (with-suppressed-warnings ((lexical headers)) (defvar headers)) + (let ((headers headers)) + (mapcar + (lambda (rule) + (cons (car rule) (eval (cdr rule) t))) + merge-rules))) (defvar mail-header-format-function (lambda (header value) @@ -167,7 +170,7 @@ A key of nil has as its value a list of defaulted headers to ignore." (mapcar #'car format-rules)))) (dolist (rule format-rules) (let* ((header (car rule)) - (value (mail-header header))) + (value (alist-get header headers))) (if (stringp header) (setq header (intern header))) (cond ((null header) 'ignore) @@ -176,13 +179,11 @@ A key of nil has as its value a list of defaulted headers to ignore." (unless (memq (car defaulted) ignore) (let* ((header (car defaulted)) (value (cdr defaulted))) - (if (cdr rule) - (funcall (cdr rule) header value) - (funcall mail-header-format-function header value)))))) + (funcall (or (cdr rule) mail-header-format-function) + header value))))) (value - (if (cdr rule) - (funcall (cdr rule) header value) - (funcall mail-header-format-function header value)))))) + (funcall (or (cdr rule) mail-header-format-function) + header value))))) (insert "\n"))) (provide 'mailheader) diff --git a/lisp/mail/mspools.el b/lisp/mail/mspools.el index 970f52c3374..6d834140582 100644 --- a/lisp/mail/mspools.el +++ b/lisp/mail/mspools.el @@ -167,11 +167,11 @@ your primary spool is. If this fails, set it to something like (defvar mspools-mode-map (let ((map (make-sparse-keymap))) - (define-key map "\C-c\C-c" 'mspools-visit-spool) - (define-key map "\C-m" 'mspools-visit-spool) - (define-key map " " 'mspools-visit-spool) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) + (define-key map "\C-c\C-c" #'mspools-visit-spool) + (define-key map "\C-m" #'mspools-visit-spool) + (define-key map " " #'mspools-visit-spool) + (define-key map "n" #'next-line) + (define-key map "p" #'previous-line) map) "Keymap for the *spools* buffer.") diff --git a/lisp/mail/rfc2047.el b/lisp/mail/rfc2047.el index 5b08713949f..c442913d282 100644 --- a/lisp/mail/rfc2047.el +++ b/lisp/mail/rfc2047.el @@ -612,7 +612,7 @@ should not change this value.") (setq next prev prev nil) (if (or (< index limit) - (<= (+ len (or (string-match "\n" tail) + (<= (+ len (or (string-search "\n" tail) (length tail))) rfc2047-encode-max-chars)) (setq prev next @@ -1111,7 +1111,7 @@ strings are stripped." "Decode MIME-encoded STRING and return the result. If ADDRESS-MIME is non-nil, strip backslashes which precede characters other than `\"' and `\\' in quoted strings." - (if (string-match "=\\?" string) + (if (string-search "=?" string) (with-temp-buffer ;; We used to only call mm-enable-multibyte if `m' is non-nil, ;; but this can't be the right criterion. Don't just revert this diff --git a/lisp/mail/rfc2231.el b/lisp/mail/rfc2231.el index 6fb4502b23b..a398ce0e9cc 100644 --- a/lisp/mail/rfc2231.el +++ b/lisp/mail/rfc2231.el @@ -61,12 +61,12 @@ must never cause a Lisp error." ;; make it parsable. Let's try... (error (let (mod) - (when (and (string-match "\\\\\"" string) + (when (and (string-search "\\\"" string) (not (string-match "\\`\"\\|[^\\]\"" string))) - (setq string (replace-regexp-in-string "\\\\\"" "\"" string) + (setq string (string-replace "\\\"" "\"" string) mod t)) - (when (and (string-match "\\\\(" string) - (string-match "\\\\)" string) + (when (and (string-search "\\(" string) + (string-search "\\)" string) (not (string-match "\\`(\\|[^\\][()]" string))) (setq string (replace-regexp-in-string "\\\\\\([()]\\)" "\\1" string) diff --git a/lisp/mail/rfc2368.el b/lisp/mail/rfc2368.el index 553f3cc3a54..b96f15d3e68 100644 --- a/lisp/mail/rfc2368.el +++ b/lisp/mail/rfc2368.el @@ -91,7 +91,7 @@ Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., & -> &), before calling this function." (let ((case-fold-search t) prequery query headers-alist) - (setq mailto-url (replace-regexp-in-string "\n" " " mailto-url)) + (setq mailto-url (string-replace "\n" " " mailto-url)) (if (string-match rfc2368-mailto-regexp mailto-url) (progn (setq prequery diff --git a/lisp/mail/rfc822.el b/lisp/mail/rfc822.el index f07fcdfc9f1..2e97226662f 100644 --- a/lisp/mail/rfc822.el +++ b/lisp/mail/rfc822.el @@ -1,4 +1,4 @@ -;;; rfc822.el --- hairy RFC 822 (or later) parser for mail, news, etc. +;;; rfc822.el --- hairy RFC 822 (or later) parser for mail, news, etc. -*- lexical-binding: t; -*- ;; Copyright (C) 1986-1987, 1990, 2001-2021 Free Software Foundation, ;; Inc. diff --git a/lisp/mail/rmail-spam-filter.el b/lisp/mail/rmail-spam-filter.el index dda472eb30e..fbac9e0cc0c 100644 --- a/lisp/mail/rmail-spam-filter.el +++ b/lisp/mail/rmail-spam-filter.el @@ -1,4 +1,4 @@ -;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader +;;; rmail-spam-filter.el --- spam filter for Rmail, the Emacs mail reader -*- lexical-binding: t; -*- ;; Copyright (C) 2002-2021 Free Software Foundation, Inc. ;; Keywords: email, spam, filter, rmail @@ -82,50 +82,42 @@ (defcustom rmail-use-spam-filter nil "Non-nil to activate the Rmail spam filter. Set `rsf-definitions-alist' to define what you consider spam emails." - :type 'boolean - :group 'rmail-spam-filter) + :type 'boolean) (defcustom rsf-file "~/XRMAIL-SPAM" "Name of Rmail file for optionally saving some of the spam. You can either just delete spam, or save it in this file for later review. Which action to take for each spam definition is specified by the \"action\" element of the definition." - :type 'string - :group 'rmail-spam-filter) + :type 'string) (defcustom rsf-no-blind-cc nil "Non-nil means mail with no explicit To: or Cc: is spam." - :type 'boolean - :group 'rmail-spam-filter) + :type 'boolean) (defcustom rsf-ignore-case nil "Non-nil means to ignore case in `rsf-definitions-alist'." - :type 'boolean - :group 'rmail-spam-filter) + :type 'boolean) (defcustom rsf-beep nil "Non-nil means to beep if spam is found." - :type 'boolean - :group 'rmail-spam-filter) + :type 'boolean) (defcustom rsf-sleep-after-message 2.0 "Seconds to wait after displaying a message that spam was found." - :type 'number - :group 'rmail-spam-filter) + :type 'number) (defcustom rsf-min-region-to-spam-list 7 "Minimum size of region that you can add to the spam list. The aim is to avoid adding too short a region, which could result in false positive identification of a valid message as spam." - :type 'integer - :group 'rmail-spam-filter) + :type 'integer) (defcustom rsf-autosave-newly-added-definitions nil "Non-nil to auto-save new spam entries. Any time you add an entry via the \"Spam\" menu, immediately saves the custom file." - :type 'boolean - :group 'rmail-spam-filter) + :type 'boolean) (defcustom rsf-white-list nil "List of regexps to identify valid senders. @@ -133,8 +125,7 @@ If any element matches the \"From\" header, the message is flagged as a valid, non-spam message. E.g., if your domain is \"emacs.com\" then including \"emacs\\\\.com\" in this list would flag all mail (purporting to be) from your colleagues as valid." - :type '(repeat regexp) - :group 'rmail-spam-filter) + :type '(repeat regexp)) (defcustom rsf-definitions-alist nil "A list of rules (definitions) matching spam messages. @@ -178,8 +169,7 @@ A rule matches only if all the specified elements match." (choice :tag "Action selection" (const :tag "Output and delete" output-and-delete) (const :tag "Delete" delete-spam) - )))) - :group 'rmail-spam-filter) + ))))) ;; FIXME nothing uses this, and it could just be let-bound. (defvar rsf-scanning-messages-now nil @@ -224,6 +214,8 @@ the cdr is set to t. Else, the car is set to nil." ;; empty buffer. (1- (or (rmail-first-unseen-message) 1)))) +(defvar bbdb/mail_auto_create_p) + (defun rmail-spam-filter (msg) "Return nil if message number MSG is spam based on `rsf-definitions-alist'. If spam, optionally output message to a file `rsf-file' and delete @@ -522,12 +514,12 @@ to the spam list (remember to save it)" region-to-spam-list)))))) ["Customize spam definitions" rsf-customize-spam-definitions] ["Browse spam customizations" rsf-customize-group] )) - (define-key map "\C-cSt" 'rsf-add-subject-to-spam-list) - (define-key map "\C-cSr" 'rsf-add-sender-to-spam-list) - (define-key map "\C-cSn" 'rsf-add-region-to-spam-list) - (define-key map "\C-cSa" 'rsf-custom-save-all) - (define-key map "\C-cSd" 'rsf-customize-spam-definitions) - (define-key map "\C-cSg" 'rsf-customize-group)) + (define-key map "\C-cSt" #'rsf-add-subject-to-spam-list) + (define-key map "\C-cSr" #'rsf-add-sender-to-spam-list) + (define-key map "\C-cSn" #'rsf-add-region-to-spam-list) + (define-key map "\C-cSa" #'rsf-custom-save-all) + (define-key map "\C-cSd" #'rsf-customize-spam-definitions) + (define-key map "\C-cSg" #'rsf-customize-group)) (defun rsf-add-content-type-field () "Maintain backward compatibility for `rmail-spam-filter'. @@ -563,4 +555,4 @@ checks to see if the old format is used, and updates it if necessary." (provide 'rmail-spam-filter) -;;; rmail-spam-filter ends here +;;; rmail-spam-filter.el ends here diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 8ccf1bffdd6..8a38337773e 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -551,7 +551,7 @@ Examples: (defvar rmail-reply-regexp (concat "\\`\\(" rmail-re-abbrevs - "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?[:：] *\\)*") + "\\(([0-9]+)\\|\\[[0-9]+\\]\\|\\^[0-9]+\\)?\u00a0*[:：] *\\)*") "Regexp to delete from Subject line before inserting `rmail-reply-prefix'.") (defcustom rmail-display-summary nil @@ -1721,7 +1721,7 @@ not be a new one). It returns non-nil if it got any new messages." (buffer-read-only nil) ;; Don't make undo records while getting mail. (buffer-undo-list t) - delete-files files file-last-names) + files file-last-names) ;; delete-files ;; Pull files off all-files onto files as long as there is ;; no name conflict. A conflict happens when two inbox ;; file names have the same last component. @@ -1743,7 +1743,7 @@ not be a new one). It returns non-nil if it got any new messages." (while (not (looking-back "\n\n" (- (point) 2))) (insert "\n"))) (setq found (or - (rmail-get-new-mail-1 file-name files delete-files) + (rmail-get-new-mail-1 file-name files nil) ;; delete-files found)))) ;; Move to the first new message unless we have other unseen ;; messages before it. @@ -1960,7 +1960,7 @@ Value is the size of the newly read mail after conversion." (file-name-nondirectory (if (memq system-type '(windows-nt cygwin ms-dos)) ;; cannot have colons in file name - (replace-regexp-in-string ":" "-" file) + (string-replace ":" "-" file) file))) ;; Use the directory of this rmail file ;; because it's a nuisance to use the homedir @@ -3356,7 +3356,12 @@ whitespace, replacing whitespace runs with a single space and removing prefixes such as Re:, Fwd: and so on and mailing list tags such as [tag]." (let ((subject (or (rmail-get-header "Subject" msgnum) "")) - (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}[:：]\\|\\[[^]]+]\\)[ \t\n]+\\)*")) + (regexp "\\`[ \t\n]*\\(\\(\\w\\{1,4\\}\u00a0*[:：]\\|\\[[^]]+]\\)[ \t\n]+\\)*")) + ;; Corporate mailing systems sometimes add `[External] :'; if that happened, + ;; delete everything up thru there. Empirically, that deletion makes + ;; the Subject match the other messages in the thread. + (if (string-match "\\[external][ \t\n]*:" subject) + (setq subject (substring subject (match-end 0)))) (setq subject (rfc2047-decode-string subject)) (setq subject (replace-regexp-in-string regexp "" subject)) (replace-regexp-in-string "[ \t\n]+" " " subject))) @@ -3369,7 +3374,7 @@ The idea is to match it against simplified subjects of other messages." ;; Hide commas so it will work ok if parsed as a comma-separated list ;; of regexps. (setq subject - (replace-regexp-in-string "," "\054" subject t t)) + (string-replace "," "\054" subject)) (concat "\\`" subject "\\'"))) (defun rmail-next-same-subject (n) @@ -3671,9 +3676,9 @@ If BUFFER is not swapped, yank out of its message viewer buffer." (push (cons "cc" cc) other-headers) (push (cons "in-reply-to" in-reply-to) other-headers) (setq other-headers - (mapcar #'(lambda (elt) - (cons (car elt) (if (stringp (cdr elt)) - (rfc2047-decode-string (cdr elt))))) + (mapcar (lambda (elt) + (cons (car elt) (if (stringp (cdr elt)) + (rfc2047-decode-string (cdr elt))))) other-headers)) (if (stringp to) (setq to (rfc2047-decode-string to))) (if (stringp in-reply-to) @@ -3762,32 +3767,61 @@ use \\[mail-yank-original] to yank the original message into it." (rmail-apply-in-message rmail-current-message (lambda () - (search-forward "\n\n" nil 'move) - (narrow-to-region (point-min) (point)) - (setq from (mail-fetch-field "from") - reply-to (or (mail-fetch-field "mail-reply-to" nil t) - (mail-fetch-field "reply-to" nil t) - from) - subject (mail-fetch-field "subject") - date (mail-fetch-field "date") - message-id (mail-fetch-field "message-id") - references (mail-fetch-field "references" nil nil t) - ;; Bug#512. It's inappropriate to reply to these addresses. - ;;resent-reply-to (mail-fetch-field "resent-reply-to" nil t) - ;;resent-cc (and (not just-sender) - ;; (mail-fetch-field "resent-cc" nil t)) - ;;resent-to (or (mail-fetch-field "resent-to" nil t) "") - ;;resent-subject (mail-fetch-field "resent-subject") - ;;resent-date (mail-fetch-field "resent-date") - ;;resent-message-id (mail-fetch-field "resent-message-id") - ) - (unless just-sender - (if (mail-fetch-field "mail-followup-to" nil t) - ;; If this header field is present, use it instead of the - ;; To and Cc fields. - (setq to (mail-fetch-field "mail-followup-to" nil t)) - (setq cc (or (mail-fetch-field "cc" nil t) "") - to (or (mail-fetch-field "to" nil t) "")))))) + (let ((end (point-max)) + subheader) + ;; Find the message's real header. + (search-forward "\n\n" nil 'move) + (narrow-to-region (point-min) (point)) + + (goto-char (point-min)) + + ;; If this is an encrypted message, search for other header fields + ;; inside the encrypted part, and use them instead of the real header. + + ;; First, find a From: field after a plausible section start. + (when (and (search-forward "\nContent-Type: multipart/encrypted;\n" nil t) + (save-restriction + (narrow-to-region (point-min) end) + (and (search-forward "\nFrom: " nil t) + (setq subheader (point))))) + ;; We found one, so widen up to end of message and go there. + (narrow-to-region (point-min) end) + (goto-char subheader) + + ;; Find the start of the inner header. + (search-backward "\n--") + (forward-line 2) + + ;; Find the end of it. + (let ((subheader-start (point))) + (goto-char subheader) + (search-forward "\n\n" nil 'move) + (narrow-to-region subheader-start (point)))) + + (setq from (mail-fetch-field "from") + reply-to (or (mail-fetch-field "mail-reply-to" nil t) + (mail-fetch-field "reply-to" nil t) + from) + subject (mail-fetch-field "subject") + date (mail-fetch-field "date") + message-id (mail-fetch-field "message-id") + references (mail-fetch-field "references" nil nil t) + ;; Bug#512. It's inappropriate to reply to these addresses. + ;;resent-reply-to (mail-fetch-field "resent-reply-to" nil t) + ;;resent-cc (and (not just-sender) + ;; (mail-fetch-field "resent-cc" nil t)) + ;;resent-to (or (mail-fetch-field "resent-to" nil t) "") + ;;resent-subject (mail-fetch-field "resent-subject") + ;;resent-date (mail-fetch-field "resent-date") + ;;resent-message-id (mail-fetch-field "resent-message-id") + ) + (unless just-sender + (if (mail-fetch-field "mail-followup-to" nil t) + ;; If this header field is present, use it instead of the + ;; To and Cc fields. + (setq to (mail-fetch-field "mail-followup-to" nil t)) + (setq cc (or (mail-fetch-field "cc" nil t) "") + to (or (mail-fetch-field "to" nil t) ""))))))) ;; Merge the resent-to and resent-cc into the to and cc. ;; Bug#512. It's inappropriate to reply to these addresses. ;;(if (and resent-to (not (equal resent-to ""))) @@ -4585,8 +4619,9 @@ Argument MIME is non-nil if this is a mime message." ;; change it in one of the calls to `epa-decrypt-region'. (save-excursion - (let (decrypts (mime (rmail-mime-message-p)) - mime-disabled) + (let (decrypts + (mime (and (eq major-mode 'rmail-mode) (rmail-mime-message-p))) + mime-disabled) (goto-char (point-min)) ;; Turn off mime processing. diff --git a/lisp/mail/rmailedit.el b/lisp/mail/rmailedit.el index c3b351d7bc8..fd24bdceccc 100644 --- a/lisp/mail/rmailedit.el +++ b/lisp/mail/rmailedit.el @@ -1,4 +1,4 @@ -;;; rmailedit.el --- "RMAIL edit mode" Edit the current message +;;; rmailedit.el --- "RMAIL edit mode" Edit the current message -*- lexical-binding: t; -*- ;; Copyright (C) 1985, 1994, 2001-2021 Free Software Foundation, Inc. @@ -38,8 +38,8 @@ (let ((map (make-sparse-keymap))) ;; Make a keymap that inherits text-mode-map. (set-keymap-parent map text-mode-map) - (define-key map "\C-c\C-c" 'rmail-cease-edit) - (define-key map "\C-c\C-]" 'rmail-abort-edit) + (define-key map "\C-c\C-c" #'rmail-cease-edit) + (define-key map "\C-c\C-]" #'rmail-abort-edit) map)) (declare-function rmail-summary-disable "rmailsum" ()) @@ -69,7 +69,7 @@ This function runs the hooks `text-mode-hook' and `rmail-edit-mode-hook'. (setq-local auto-save-include-big-deletions t) ;; If someone uses C-x C-s, don't clobber the rmail file (bug#2625). (add-hook 'write-region-annotate-functions - 'rmail-write-region-annotate nil t) + #'rmail-write-region-annotate nil t) (run-mode-hooks 'rmail-edit-mode-hook))) ;; Rmail Edit mode is suitable only for specially formatted data. diff --git a/lisp/mail/rmailkwd.el b/lisp/mail/rmailkwd.el index 657b3629bd1..58a8eb7a370 100644 --- a/lisp/mail/rmailkwd.el +++ b/lisp/mail/rmailkwd.el @@ -1,4 +1,4 @@ -;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs +;;; rmailkwd.el --- part of the "RMAIL" mail reader for Emacs -*- lexical-binding: t; -*- ;; Copyright (C) 1985, 1988, 1994, 2001-2021 Free Software Foundation, ;; Inc. @@ -73,7 +73,7 @@ according to the choice made, and returns a symbol." (or (eq major-mode 'rmail-summary-mode) (rmail-summary-exists) (and (setq old (rmail-get-keywords)) - (mapc 'rmail-make-label (split-string old ", ")))) + (mapc #'rmail-make-label (split-string old ", ")))) (completing-read (concat prompt (if rmail-last-label (concat " (default " @@ -93,7 +93,7 @@ according to the choice made, and returns a symbol." "Set LABEL as present or absent according to STATE in message MSG. LABEL may be a symbol or string." (or (stringp label) (setq label (symbol-name label))) - (if (string-match "," label) + (if (string-search "," label) (error "More than one label specified")) (with-current-buffer rmail-buffer (rmail-maybe-set-message-counters) diff --git a/lisp/mail/rmailmm.el b/lisp/mail/rmailmm.el index ab5b49aab92..99bff66657b 100644 --- a/lisp/mail/rmailmm.el +++ b/lisp/mail/rmailmm.el @@ -1,4 +1,4 @@ -;;; rmailmm.el --- MIME decoding and display stuff for RMAIL +;;; rmailmm.el --- MIME decoding and display stuff for RMAIL -*- lexical-binding: t; -*- ;; Copyright (C) 2006-2021 Free Software Foundation, Inc. @@ -78,6 +78,7 @@ (require 'rmail) (require 'mail-parse) (require 'message) +(require 'cl-lib) ;;; User options. @@ -101,8 +102,7 @@ all others are handled by `rmail-mime-bulk-handler'. Note also that this alist is ignored when the variable `rmail-enable-mime' is non-nil." :type '(alist :key-type regexp :value-type (repeat function)) - :version "23.1" - :group 'rmail-mime) + :version "23.1") (defcustom rmail-mime-attachment-dirs-alist `(("text/.*" "~/Documents") @@ -114,8 +114,7 @@ The first item is a regular expression matching a content-type. The remaining elements are directories, in order of decreasing preference. The first directory that exists is used." :type '(alist :key-type regexp :value-type (repeat directory)) - :version "23.1" - :group 'rmail-mime) + :version "23.1") (defcustom rmail-mime-show-images 'button "What to do with image attachments that Emacs is capable of displaying. @@ -128,12 +127,11 @@ automatically display the image in the buffer." (const :tag "No special treatment" nil) (number :tag "Show if smaller than certain size") (other :tag "Always show" show)) - :version "23.2" - :group 'rmail-mime) + :version "23.2") (defcustom rmail-mime-render-html-function - (cond ((fboundp 'libxml-parse-html-region) 'rmail-mime-render-html-shr) - ((executable-find "lynx") 'rmail-mime-render-html-lynx) + (cond ((fboundp 'libxml-parse-html-region) #'rmail-mime-render-html-shr) + ((executable-find "lynx") #'rmail-mime-render-html-lynx) (t nil)) "Function to convert HTML to text. Called with buffer containing HTML extracted from message in a @@ -177,9 +175,12 @@ operations such as HTML decoding") ;;; MIME-entity object -(defun rmail-mime-entity (type disposition transfer-encoding - display header tagline body children handler - &optional truncated) +(cl-defstruct (rmail-mime-entity + (:copier nil) (:constructor nil) + (:constructor rmail-mime-entity + ( type disposition transfer-encoding + display header tagline body children handler + &optional truncated) "Return a newly created MIME-entity object from arguments. A MIME-entity is a vector of 10 elements: @@ -210,12 +211,7 @@ Content-Transfer-Encoding, and is a lower-case string. DISPLAY is a vector [CURRENT NEW], where CURRENT indicates how the header, tag line, and body of the entity are displayed now, and NEW indicates how their display should be updated. -Both elements are vectors [HEADER-DISPLAY TAGLINE-DISPLAY BODY-DISPLAY], -where each constituent element is a symbol for the corresponding -item with these values: - nil: not displayed - t: displayed by the decoded presentation form - raw: displayed by the raw MIME data (for the header and body only) +Both elements are `rmail-mime-display' objects. HEADER and BODY are vectors [BEG END DISPLAY-FLAG], where BEG and END are markers that specify the region of the header or body lines @@ -236,24 +232,13 @@ has just one child. Any other entity has no child. HANDLER is a function to insert the entity according to DISPLAY. It is called with one argument ENTITY. -TRUNCATED is non-nil if the text of this entity was truncated." - - (vector type disposition transfer-encoding - display header tagline body children handler truncated)) - -;; Accessors for a MIME-entity object. -(defsubst rmail-mime-entity-type (entity) (aref entity 0)) -(defsubst rmail-mime-entity-disposition (entity) (aref entity 1)) -(defsubst rmail-mime-entity-transfer-encoding (entity) (aref entity 2)) -(defsubst rmail-mime-entity-display (entity) (aref entity 3)) -(defsubst rmail-mime-entity-header (entity) (aref entity 4)) -(defsubst rmail-mime-entity-tagline (entity) (aref entity 5)) -(defsubst rmail-mime-entity-body (entity) (aref entity 6)) -(defsubst rmail-mime-entity-children (entity) (aref entity 7)) -(defsubst rmail-mime-entity-handler (entity) (aref entity 8)) -(defsubst rmail-mime-entity-truncated (entity) (aref entity 9)) +TRUNCATED is non-nil if the text of this entity was truncated.")) + type disposition transfer-encoding + display header tagline body children handler truncated) + (defsubst rmail-mime-entity-set-truncated (entity truncated) - (aset entity 9 truncated)) + (declare (obsolete (setf rmail-mime-entity-truncated) "28.1")) + (setf (rmail-mime-entity-truncated entity) truncated)) ;;; Buttons @@ -303,9 +288,16 @@ TRUNCATED is non-nil if the text of this entity was truncated." ;; Display options returned by rmail-mime-entity-display. ;; Value is on of nil, t, raw. -(defsubst rmail-mime-display-header (disp) (aref disp 0)) -(defsubst rmail-mime-display-tagline (disp) (aref disp 1)) -(defsubst rmail-mime-display-body (disp) (aref disp 2)) +(cl-defstruct (rmail-mime-display + (:copier rmail-mime--copy-display) (:constructor nil) + (:constructor rmail-mime--make-display (header tagline body) + "Make an object describing how to display. +Each field's value is a symbol for the corresponding +item with these values: + nil: not displayed + t: displayed by the decoded presentation form + raw: displayed by the raw MIME data (for the header and body only).")) + header tagline body) (defun rmail-mime-entity-segment (pos &optional entity) "Return a vector describing the displayed region of a MIME-entity at POS. @@ -371,27 +363,30 @@ The value is a vector [INDEX HEADER TAGLINE BODY END], where (defun rmail-mime-shown-mode (entity) "Make MIME-entity ENTITY display in the default way." (let ((new (aref (rmail-mime-entity-display entity) 1))) - (aset new 0 (aref (rmail-mime-entity-header entity) 2)) - (aset new 1 (aref (rmail-mime-entity-tagline entity) 2)) - (aset new 2 (aref (rmail-mime-entity-body entity) 2))) + (setf (rmail-mime-display-header new) + (aref (rmail-mime-entity-header entity) 2)) + (setf (rmail-mime-display-tagline new) + (aref (rmail-mime-entity-tagline entity) 2)) + (setf (rmail-mime-display-body new) + (aref (rmail-mime-entity-body entity) 2))) (dolist (child (rmail-mime-entity-children entity)) (rmail-mime-shown-mode child))) (defun rmail-mime-hidden-mode (entity) "Make MIME-entity ENTITY display in hidden mode." (let ((new (aref (rmail-mime-entity-display entity) 1))) - (aset new 0 nil) - (aset new 1 t) - (aset new 2 nil)) + (setf (rmail-mime-display-header new) nil) + (setf (rmail-mime-display-tagline new) t) + (setf (rmail-mime-display-body new) nil)) (dolist (child (rmail-mime-entity-children entity)) (rmail-mime-hidden-mode child))) (defun rmail-mime-raw-mode (entity) "Make MIME-entity ENTITY display in raw mode." (let ((new (aref (rmail-mime-entity-display entity) 1))) - (aset new 0 'raw) - (aset new 1 nil) - (aset new 2 'raw)) + (setf (rmail-mime-display-header new) 'raw) + (setf (rmail-mime-display-tagline new) nil) + (setf (rmail-mime-display-body new) 'raw)) (dolist (child (rmail-mime-entity-children entity)) (rmail-mime-raw-mode child))) @@ -404,8 +399,8 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode." (current (aref (rmail-mime-entity-display entity) 0)) (segment (rmail-mime-entity-segment pos entity))) (if (or (eq state 'raw) - (and (not state) - (not (eq (rmail-mime-display-header current) 'raw)))) + (not (or state + (eq (rmail-mime-display-header current) 'raw)))) ;; Enter the raw mode. (rmail-mime-raw-mode entity) ;; Enter the shown mode. @@ -439,7 +434,7 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode." ;; header. (if (and rmail-mime-mbox-buffer (= (aref segment 1) (point-min))) (let ((new (aref (rmail-mime-entity-display entity) 1))) - (aset new 0 t)))) + (setf (rmail-mime-display-header new) t)))) ;; Query as a warning before showing if truncated. (if (and (not (stringp entity)) (rmail-mime-entity-truncated entity)) @@ -448,7 +443,8 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode." ;; Enter the shown mode. (rmail-mime-shown-mode entity) ;; Force this body shown. - (aset (aref (rmail-mime-entity-display entity) 1) 2 t)) + (let ((new (aref (rmail-mime-entity-display entity) 1))) + (setf (rmail-mime-display-body new) t))) (let ((inhibit-read-only t) (modified (buffer-modified-p)) (rmail-mime-mbox-buffer rmail-view-buffer) @@ -458,9 +454,9 @@ Use `raw' for raw mode, and any other non-nil value for decoded mode." (rmail-mime-insert entity) (restore-buffer-modified-p modified)))))) -(define-key rmail-mode-map "\t" 'forward-button) -(define-key rmail-mode-map [backtab] 'backward-button) -(define-key rmail-mode-map "\r" 'rmail-mime-toggle-hidden) +(define-key rmail-mode-map "\t" #'forward-button) +(define-key rmail-mode-map [backtab] #'backward-button) +(define-key rmail-mode-map "\r" #'rmail-mime-toggle-hidden) ;;; Handlers @@ -483,7 +479,7 @@ to the tag line." (when item (if (stringp item) (insert item) - (apply 'insert-button item)))) + (apply #'insert-button item)))) ;; Follow the tagline by an empty line to make it a separate ;; paragraph, so that the paragraph direction of the following text ;; is determined based on that text. @@ -495,8 +491,10 @@ to the tag line." (modified (buffer-modified-p)) ;; If we are going to show the body, the new button label is ;; "Hide". Otherwise, it's "Show". - (label (if (aref (aref (rmail-mime-entity-display entity) 1) 2) "Hide" - "Show")) + (label + (if (rmail-mime-display-body + (aref (rmail-mime-entity-display entity) 1)) + "Hide" "Show")) (button (next-button (point)))) ;; Go to the second character of the button "Show" or "Hide". (goto-char (1+ (button-start button))) @@ -556,9 +554,10 @@ HEADER is a header component of a MIME-entity object (see (rmail-mime-insert-text (rmail-mime-entity content-type content-disposition content-transfer-encoding - (vector (vector nil nil nil) (vector nil nil t)) + (vector (rmail-mime--make-display nil nil nil) + (rmail-mime--make-display nil nil t)) (vector nil nil nil) (vector "" (cons nil nil) t) - (vector nil nil nil) nil 'rmail-mime-insert-text)) + (vector nil nil nil) nil #'rmail-mime-insert-text)) t) (defun rmail-mime-insert-decoded-text (entity) @@ -592,7 +591,7 @@ HEADER is a header component of a MIME-entity object (see (let ((current (aref (rmail-mime-entity-display entity) 0)) (new (aref (rmail-mime-entity-display entity) 1)) (header (rmail-mime-entity-header entity)) - (tagline (rmail-mime-entity-tagline entity)) + ;; (tagline (rmail-mime-entity-tagline entity)) (body (rmail-mime-entity-body entity)) (beg (point)) (segment (rmail-mime-entity-segment (point) entity))) @@ -634,7 +633,7 @@ HEADER is a header component of a MIME-entity object (see (defun rmail-mime-insert-image (entity) "Decode and insert the image body of MIME-entity ENTITY." - (let* ((content-type (car (rmail-mime-entity-type entity))) + (let* (;; (content-type (car (rmail-mime-entity-type entity))) (bulk-data (aref (rmail-mime-entity-tagline entity) 1)) (body (rmail-mime-entity-body entity)) data) @@ -709,6 +708,9 @@ HEADER is a header component of a MIME-entity object (see (declare-function libxml-parse-html-region "xml.c" (start end &optional base-url discard-comments)) +(defvar shr-inhibit-images) +(defvar shr-width) + (defun rmail-mime-render-html-shr (source-buffer) (let ((dom (with-current-buffer source-buffer (libxml-parse-html-region (point-min) (point-max)))) @@ -759,7 +761,8 @@ For images that Emacs is capable of displaying, the behavior depends upon the value of `rmail-mime-show-images'." (rmail-mime-insert-bulk (rmail-mime-entity content-type content-disposition content-transfer-encoding - (vector (vector nil nil nil) (vector nil t nil)) + (vector (rmail-mime--make-display nil nil nil) + (rmail-mime--make-display nil t nil)) (vector nil nil nil) (vector "" (cons nil nil) t) (vector nil nil nil) nil 'rmail-mime-insert-bulk))) @@ -781,9 +784,11 @@ directly." (let ((encoding (rmail-mime-entity-transfer-encoding entity))) (setq size (- (aref body 1) (aref body 0))) (cond ((string= encoding "base64") - (setq size (/ (* size 3) 4))) + ;; https://en.wikipedia.org/wiki/Base64#MIME + (setq size (* size 0.73))) ((string= encoding "quoted-printable") - (setq size (/ (* size 7) 3))))))) + ;; Assume most of the text is ASCII... + (setq size (/ (* size 5) 7))))))) (cond ((string-match "text/html" content-type) @@ -1024,9 +1029,10 @@ The other arguments are the same as `rmail-mime-multipart-handler'." nil (format "%s/%d" parse-tag index) content-type content-disposition))) ;; Display a tagline. - (aset (aref (rmail-mime-entity-display child) 1) 1 + (setf (rmail-mime-display-tagline + (aref (rmail-mime-entity-display child) 1)) (aset (rmail-mime-entity-tagline child) 2 t)) - (rmail-mime-entity-set-truncated child truncated) + (setf (rmail-mime-entity-truncated child) truncated) (push child entities))) (delete-region end next) @@ -1072,8 +1078,8 @@ The other arguments are the same as `rmail-mime-multipart-handler'." (let ((current (aref (rmail-mime-entity-display entity) 0)) (new (aref (rmail-mime-entity-display entity) 1)) (header (rmail-mime-entity-header entity)) - (tagline (rmail-mime-entity-tagline entity)) - (body (rmail-mime-entity-body entity)) + ;; (tagline (rmail-mime-entity-tagline entity)) + ;; (body (rmail-mime-entity-body entity)) (beg (point)) (segment (rmail-mime-entity-segment (point) entity))) ;; header @@ -1169,13 +1175,11 @@ The parsed header value: content-transfer-encoding)) (save-restriction (widen) - (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity)) - current new) + (let ((entity (get-text-property (1- (point)) 'rmail-mime-entity))) (when entity - (setq current (aref (rmail-mime-entity-display entity) 0) - new (aref (rmail-mime-entity-display entity) 1)) - (dotimes (i 3) - (aset current i (aref new i))))))) + (let ((new (aref (rmail-mime-entity-display entity) 1))) + (setf (aref (rmail-mime-entity-display entity) 0) + (rmail-mime--copy-display new))))))) (defun rmail-mime-show (&optional show-headers) "Handle the current buffer as a MIME message. @@ -1240,13 +1244,15 @@ modified." (header (vector (point-min-marker) hdr-end nil)) (tagline (vector parse-tag (cons nil nil) t)) (body (vector hdr-end (point-max-marker) is-inline)) - (new (vector (aref header 2) (aref tagline 2) (aref body 2))) + (new (rmail-mime--make-display + (aref header 2) (aref tagline 2) (aref body 2))) children handler entity) (cond ((string-match "multipart/.*" (car content-type)) (save-restriction (narrow-to-region (1- end) (point-max)) (if (zerop (length parse-tag)) ; top level of message - (aset new 1 (aset tagline 2 nil))) ; don't show tagline + (setf (rmail-mime-display-tagline new) + (aset tagline 2 nil))) ; don't show tagline (setq children (rmail-mime-process-multipart content-type content-disposition @@ -1260,37 +1266,38 @@ modified." '("text/plain") '("inline"))) (msg-new (aref (rmail-mime-entity-display msg) 1))) ;; Show header of the child. - (aset msg-new 0 t) + (setf (rmail-mime-display-header msg-new) t) (aset (rmail-mime-entity-header msg) 2 t) ;; Hide tagline of the child. - (aset msg-new 1 nil) + (setf (rmail-mime-display-tagline msg-new) nil) (aset (rmail-mime-entity-tagline msg) 2 nil) (setq children (list msg) handler 'rmail-mime-insert-multipart)))) ((and is-inline (string-match "text/html" (car content-type))) ;; Display tagline, so part can be detached - (aset new 1 (aset tagline 2 t)) - (aset new 2 (aset body 2 t)) ; display body also. + (setf (rmail-mime-display-tagline new) (aset tagline 2 t)) + (setf (rmail-mime-display-body new) (aset body 2 t)) ; display body also. (setq handler 'rmail-mime-insert-bulk)) ;; Inline non-HTML text ((and is-inline (string-match "text/" (car content-type))) ;; Don't need a tagline. - (aset new 1 (aset tagline 2 nil)) + (setf (rmail-mime-display-tagline new) (aset tagline 2 nil)) (setq handler 'rmail-mime-insert-text)) (t ;; Force hidden mode. - (aset new 1 (aset tagline 2 t)) - (aset new 2 (aset body 2 nil)) + (setf (rmail-mime-display-tagline new) (aset tagline 2 t)) + (setf (rmail-mime-display-body new) (aset body 2 nil)) (setq handler 'rmail-mime-insert-bulk))) - (setq entity (rmail-mime-entity content-type - content-disposition - content-transfer-encoding - (vector (vector nil nil nil) new) - header tagline body children handler)) + (setq entity (rmail-mime-entity + content-type + content-disposition + content-transfer-encoding + (vector (rmail-mime--make-display nil nil nil) new) + header tagline body children handler)) (if (and (eq handler 'rmail-mime-insert-bulk) (rmail-mime-set-bulk-data entity)) ;; Show the body. - (aset new 2 (aset body 2 t))) + (setf (rmail-mime-display-body new) (aset body 2 t))) entity) ;; Hide headers and handle the part. @@ -1324,7 +1331,8 @@ If an error occurs, return an error message string." '("text/plain") '("inline"))) (new (aref (rmail-mime-entity-display entity) 1))) ;; Show header. - (aset new 0 (aset (rmail-mime-entity-header entity) 2 t)) + (setf (rmail-mime-display-header new) + (aset (rmail-mime-entity-header entity) 2 t)) entity))) (error (format "%s" err))))) @@ -1339,7 +1347,7 @@ available." ;; Not a raw-mode. Each handler should handle it. (funcall (rmail-mime-entity-handler entity) entity) (let ((header (rmail-mime-entity-header entity)) - (tagline (rmail-mime-entity-tagline entity)) + ;; (tagline (rmail-mime-entity-tagline entity)) (body (rmail-mime-entity-body entity)) (beg (point)) (segment (rmail-mime-entity-segment (point) entity))) @@ -1370,15 +1378,15 @@ available." (aref body 0) (aref body 1)) (or (bolp) (insert "\n"))) (put-text-property beg (point) 'rmail-mime-entity entity))))) - (dotimes (i 3) - (aset current i (aref new i))))) + (setf (aref (rmail-mime-entity-display entity) 0) + (rmail-mime--copy-display new)))) (define-derived-mode rmail-mime-mode fundamental-mode "RMIME" "Major mode used in `rmail-mime' buffers." (setq font-lock-defaults '(rmail-font-lock-keywords t t nil nil))) ;;;###autoload -(defun rmail-mime (&optional arg state) +(defun rmail-mime (&optional _arg state) "Toggle the display of a MIME message. The actual behavior depends on the value of `rmail-enable-mime'. @@ -1396,7 +1404,7 @@ are handled according to `rmail-mime-media-type-handlers-alist'. By default, this displays text and multipart messages, and offers to download attachments as specified by `rmail-mime-attachment-dirs-alist'. The arguments ARG and STATE have no effect in this case." - (interactive (list current-prefix-arg nil)) + (interactive) (if rmail-enable-mime (with-current-buffer rmail-buffer (if (or (rmail-mime-message-p) @@ -1442,7 +1450,7 @@ The arguments ARG and STATE have no effect in this case." (rmail-mime-view-buffer rmail-view-buffer) (rmail-mime-coding-system nil)) ;; If ENTITY is not a vector, it is a string describing an error. - (if (vectorp entity) + (if (rmail-mime-entity-p entity) (with-current-buffer rmail-mime-view-buffer (erase-buffer) ;; This condition-case is for catching an error in the @@ -1530,7 +1538,7 @@ This is the usual value of `rmail-insert-mime-forwarded-message-function'." (rmail-mime-view-buffer rmail-view-buffer) (header-end (save-excursion (re-search-forward "^$" nil 'move) (point))) - (body-end (point-max)) + ;; (body-end (point-max)) (entity (rmail-mime-parse))) (or ;; At first, just search the headers. diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el index ef5f3c31bbc..673b2c5a7e5 100644 --- a/lisp/mail/rmailmsc.el +++ b/lisp/mail/rmailmsc.el @@ -1,4 +1,4 @@ -;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader +;;; rmailmsc.el --- miscellaneous support functions for the RMAIL mail reader -*- lexical-binding: t; -*- ;; Copyright (C) 1985, 2001-2021 Free Software Foundation, Inc. @@ -45,7 +45,7 @@ This applies only to the current session." (nreverse (mail-parse-comma-list))))) (when (or (not rmail-inbox-list) (y-or-n-p (concat "Replace " - (mapconcat 'identity + (mapconcat #'identity rmail-inbox-list ", ") "? "))) diff --git a/lisp/mail/rmailout.el b/lisp/mail/rmailout.el index 9305a48b8d8..4c23686909c 100644 --- a/lisp/mail/rmailout.el +++ b/lisp/mail/rmailout.el @@ -1,4 +1,4 @@ -;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file +;;; rmailout.el --- "RMAIL" mail reader for Emacs: output message to a file -*- lexical-binding: t; -*- ;; Copyright (C) 1985, 1987, 1993-1994, 2001-2021 Free Software ;; Foundation, Inc. @@ -81,14 +81,14 @@ This uses `rmail-output-file-alist'." (widen) (narrow-to-region beg end) (let ((tail rmail-output-file-alist) - answer err) + answer) ;; err ;; Suggest a file based on a pattern match. (while (and tail (not answer)) (goto-char (point-min)) (if (re-search-forward (caar tail) nil t) (setq answer (condition-case err - (eval (cdar tail)) + (eval (cdar tail) t) (error (display-warning 'rmail-output @@ -197,7 +197,8 @@ display message number MSG." (defun rmail-convert-to-babyl-format () "Convert the mbox message in the current buffer to Babyl format." - (let ((count 0) (start (point-min)) + (let (;; (count 0) + (start (point-min)) (case-fold-search nil) (buffer-undo-list t)) (goto-char (point-min)) @@ -357,7 +358,7 @@ unless NOMSG is a symbol (neither nil nor t). AS-SEEN is non-nil if we are copying the message \"as seen\"." (let ((case-fold-search t) encrypted-file-name - from date) + ) ;; from date (goto-char (point-min)) ;; Preserve the Mail-From and MIME-Version fields ;; even if they have been pruned. @@ -677,9 +678,9 @@ than appending to it. Deletes the message after writing if (or (mail-fetch-field "Subject") rmail-default-body-file))) (setq default-file - (replace-regexp-in-string ":" "-" default-file)) + (string-replace ":" "-" default-file)) (setq default-file - (replace-regexp-in-string " " "-" default-file)) + (string-replace " " "-" default-file)) (list (setq rmail-default-body-file (read-file-name "Output message body to file: " diff --git a/lisp/mail/rmailsort.el b/lisp/mail/rmailsort.el index 2c42e6c8598..1669c8cd7bb 100644 --- a/lisp/mail/rmailsort.el +++ b/lisp/mail/rmailsort.el @@ -1,4 +1,4 @@ -;;; rmailsort.el --- Rmail: sort messages +;;; rmailsort.el --- Rmail: sort messages -*- lexical-binding: t; -*- ;; Copyright (C) 1990, 1993-1994, 2001-2021 Free Software Foundation, ;; Inc. @@ -142,7 +142,7 @@ If prefix argument REVERSE is non-nil, sorts in reverse order." "\\(,\\|\\'\\)") labelvec)) (setq labels (substring labels (match-end 0)))) - (setq labelvec (apply 'vector (nreverse labelvec)) + (setq labelvec (apply #'vector (nreverse labelvec)) nmax (length labelvec)) (rmail-sort-messages reverse ;; If no labels match, returns nmax; if they @@ -205,7 +205,7 @@ Numeric keys are sorted numerically, all others as strings." (inhibit-read-only t) (current-message nil) (msgnum 1) - (msginfo nil) + ;; (msginfo nil) (undo (not (eq buffer-undo-list t)))) ;; There's little hope that we can easily undo after that. (buffer-disable-undo (current-buffer)) diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index f53e6e768f8..9dd9573a9fc 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -755,7 +755,12 @@ the message being processed." (forward-char -1) (skip-chars-backward " \t") (point)))))) - len mch lo) + len mch lo newline) + ;; If there are multiple lines in FROM, + ;; discard up to the last newline in it. + (while (and (stringp from) + (setq newline (string-search "\n" from))) + (setq from (substring from (1+ newline)))) (if (or (null from) (string-match (or rmail-user-mail-address-regexp diff --git a/lisp/mail/sendmail.el b/lisp/mail/sendmail.el index cd071667562..fee11c06aa7 100644 --- a/lisp/mail/sendmail.el +++ b/lisp/mail/sendmail.el @@ -30,6 +30,7 @@ (require 'mail-utils) (require 'rfc2047) (autoload 'message-make-date "message") +(autoload 'message-narrow-to-headers "message") (defgroup sendmail nil "Mail sending commands for Emacs." @@ -725,14 +726,21 @@ Turning on Mail mode runs the normal hooks `text-mode-hook' and ;; Lines containing just >= 3 dashes, perhaps after whitespace, ;; are also sometimes used and should be separators. (setq paragraph-separate - (concat (regexp-quote mail-header-separator) + (if (zerop (length mail-header-separator)) + (concat ;; This is based on adaptive-fill-regexp (presumably ;; the idea is to allow navigation etc of cited paragraphs). - "$\\|\t*[-–!|#%;>*·•‣⁃◦ ]+$" + "\t*[-–!|#%;>*·•‣⁃◦ ]+$" "\\|[ \t]*[-[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" "--\\( \\|-+\\)$\\|" - page-delimiter))) - + page-delimiter) + (concat (regexp-quote mail-header-separator) + ;; This is based on adaptive-fill-regexp (presumably + ;; the idea is to allow navigation etc of cited paragraphs). + "$\\|\t*[-–!|#%;>*·•‣⁃◦ ]+$" + "\\|[ \t]*[-[:alnum:]]*>+[ \t]*$\\|[ \t]*$\\|" + "--\\( \\|-+\\)$\\|" + page-delimiter)))) (defun mail-header-end () "Return the buffer location of the end of headers, as a number." @@ -762,10 +770,11 @@ Concretely: replace the first blank line in the header with the separator." "Remove header separator to put the message in correct form for sendmail. Leave point at the start of the delimiter line." (goto-char (point-min)) - (when (re-search-forward - (concat "^" (regexp-quote mail-header-separator) "\n") - nil t) - (replace-match "\n")) + (unless (zerop (length mail-header-separator)) + (when (re-search-forward + (concat "^" (regexp-quote mail-header-separator) "\n") + nil t) + (replace-match "\n"))) (rfc822-goto-eoh)) (defun mail-mode-auto-fill () @@ -887,8 +896,9 @@ the user from the mailer." (concat "\\(?:[[:space:];,]\\|\\`\\)" (regexp-opt mail-mailing-lists t) "\\(?:[[:space:];,]\\|\\'\\)")))) - (mail-combine-fields "To") - (mail-combine-fields "Cc") + (unless noninteractive + (mail-combine-fields "To") + (mail-combine-fields "Cc")) ;; If there are mailing lists defined (when ml (save-excursion @@ -930,7 +940,9 @@ the user from the mailer." (error "Message contains non-ASCII characters")))) ;; Complain about any invalid line. (goto-char (point-min)) - (re-search-forward (regexp-quote mail-header-separator) (point-max) t) + ;; Search for mail-header-eeparator as whole line. + (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$") + (point-max) t) (let ((header-end (or (match-beginning 0) (point-max)))) (goto-char (point-min)) (while (< (point) header-end) @@ -961,7 +973,10 @@ the user from the mailer." (defun mail-envelope-from () "Return the envelope mail address to use when sending mail. -This function uses `mail-envelope-from'." +This function uses the `mail-envelope-from' variable. + +The buffer should be narrowed to the headers of the mail message +before this function is called." (if (eq mail-envelope-from 'header) (nth 1 (mail-extract-address-components (mail-fetch-field "From"))) @@ -1177,7 +1192,12 @@ external program defined by `sendmail-program'." ;; local binding in the mail buffer will take effect. (envelope-from (and mail-specify-envelope-from - (or (mail-envelope-from) user-mail-address)))) + (or (save-restriction + ;; Only look at the headers when fetching the + ;; envelope address. + (message-narrow-to-headers) + (mail-envelope-from)) + user-mail-address)))) (unwind-protect (with-current-buffer tembuf (erase-buffer) diff --git a/lisp/mail/smtpmail.el b/lisp/mail/smtpmail.el index 5526f2fbe64..ec9f340db86 100644 --- a/lisp/mail/smtpmail.el +++ b/lisp/mail/smtpmail.el @@ -135,8 +135,9 @@ Used for the value of `sendmail-coding-system' when (defcustom smtpmail-queue-mail nil "Non-nil means mail is queued; otherwise it is sent immediately. -If queued, it is stored in the directory `smtpmail-queue-dir' -and sent with `smtpmail-send-queued-mail'." +If queued, it is stored in the directory `smtpmail-queue-dir' and +sent with `smtpmail-send-queued-mail'. Also see +`smtpmail-store-queue-variables'." :type 'boolean) (defcustom smtpmail-queue-dir "~/Mail/queued-mail/" @@ -173,10 +174,21 @@ mean \"try again\"." :type 'integer :version "27.1") +(defcustom smtpmail-store-queue-variables nil + "If non-nil, store SMTP variables when queueing mail. +These will then be used when sending the queue." + :type 'boolean + :version "28.1") + ;;; Variables (defvar smtpmail-address-buffer) -(defvar smtpmail-recipient-address-list) +(defvar smtpmail-recipient-address-list nil) +(defvar smtpmail--stored-queue-variables + '(smtpmail-smtp-server + smtpmail-stream-type + smtpmail-smtp-service + smtpmail-smtp-user)) (defvar smtpmail-queue-counter 0) @@ -186,7 +198,7 @@ mean \"try again\"." (defvar smtpmail-auth-supported '(cram-md5 plain login) "List of supported SMTP AUTH mechanisms. The list is in preference order. -Every element should have a matching `cl-defmethod' for +Every element should have a matching `cl-defmethod' for `smtpmail-try-auth-method'.") (defvar smtpmail-mail-address nil @@ -207,11 +219,15 @@ for `smtpmail-try-auth-method'.") ;; Examine this variable now, so that ;; local binding in the mail buffer will take effect. (smtpmail-mail-address - (or (and mail-specify-envelope-from (mail-envelope-from)) - (let ((from (mail-fetch-field "from"))) - (and from - (cadr (mail-extract-address-components from)))) - (smtpmail-user-mail-address))) + (save-restriction + ;; Only look at the headers when fetching the + ;; envelope address. + (message-narrow-to-headers) + (or (and mail-specify-envelope-from (mail-envelope-from)) + (let ((from (mail-fetch-field "from"))) + (and from + (cadr (mail-extract-address-components from)))) + (smtpmail-user-mail-address)))) (smtpmail-code-conv-from (if enable-multibyte-characters (let ((sendmail-coding-system smtpmail-code-conv-from)) @@ -326,7 +342,7 @@ 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) + (if (eval mail-mailer-swallows-blank-line t) (newline)) ;; Find and handle any Fcc fields. (goto-char (point-min)) @@ -383,11 +399,17 @@ for `smtpmail-try-auth-method'.") nil t) (insert-buffer-substring tembuf) (write-file file-data) - (write-region - (concat "(setq smtpmail-recipient-address-list '" - (prin1-to-string smtpmail-recipient-address-list) - ")\n") - nil file-elisp nil 'silent) + (let ((coding-system-for-write 'utf-8)) + (with-temp-buffer + (insert "(setq ") + (dolist (var (cons 'smtpmail-recipient-address-list + ;; Perhaps store the server etc. + (and smtpmail-store-queue-variables + smtpmail--stored-queue-variables))) + (insert (format " %s %S\n" var (symbol-value var)))) + (insert ")\n") + (write-region (point-min) (point-max) file-elisp + nil 'silent))) (write-region (concat file-data "\n") nil (expand-file-name smtpmail-queue-index-file smtpmail-queue-dir) @@ -407,26 +429,30 @@ for `smtpmail-try-auth-method'.") (let (file-data file-elisp (qfile (expand-file-name smtpmail-queue-index-file smtpmail-queue-dir)) + (stored (cons 'smtpmail-recipient-address-list + smtpmail--stored-queue-variables)) + smtpmail-recipient-address-list + (smtpmail-smtp-server smtpmail-smtp-server) + (smtpmail-stream-type smtpmail-stream-type) + (smtpmail-smtp-service smtpmail-smtp-service) + (smtpmail-smtp-user smtpmail-smtp-user) result) (insert-file-contents qfile) (goto-char (point-min)) (while (not (eobp)) (setq file-data (buffer-substring (point) (line-end-position))) (setq file-elisp (concat file-data ".el")) - ;; FIXME: Avoid `load' which can execute arbitrary code and is hence - ;; a source of security holes. Better read the file and extract the - ;; data "by hand". - ;;(load file-elisp) - (with-temp-buffer - (insert-file-contents file-elisp) - (goto-char (point-min)) - (pcase (read (current-buffer)) - (`(setq smtpmail-recipient-address-list ',v) - (skip-chars-forward " \n\t") - (unless (eobp) (message "Ignoring trailing text in %S" - file-elisp)) - (setq smtpmail-recipient-address-list v)) - (sexp (error "Unexpected code in %S: %S" file-elisp sexp)))) + (let ((coding-system-for-read 'utf-8)) + (with-temp-buffer + (insert-file-contents file-elisp) + (let ((form (read (current-buffer)))) + (when (or (not (consp form)) + (not (eq (car form) 'setq)) + (not (consp (cdr form)))) + (error "Unexpected code in %S: %S" file-elisp form)) + (cl-loop for (var val) on (cdr form) by #'cddr + when (memq var stored) + do (set var val))))) ;; Insert the message literally: it is already encoded as per ;; the MIME headers, and code conversions might guess the ;; encoding wrongly. @@ -434,15 +460,20 @@ for `smtpmail-try-auth-method'.") (let ((coding-system-for-read 'no-conversion)) (insert-file-contents file-data)) (let ((smtpmail-mail-address - (or (and mail-specify-envelope-from (mail-envelope-from)) + (or (and mail-specify-envelope-from + (save-restriction + ;; Only look at the headers when fetching the + ;; envelope address. + (message-narrow-to-headers) + (mail-envelope-from))) user-mail-address))) - (if (not (null smtpmail-recipient-address-list)) - (when (setq result (smtpmail-via-smtp - smtpmail-recipient-address-list - (current-buffer))) - (error "Sending failed: %s" - (smtpmail--sanitize-error-message result))) - (error "Sending failed; no recipients")))) + (if (not smtpmail-recipient-address-list) + (error "Sending failed; no recipients") + (when (setq result (smtpmail-via-smtp + smtpmail-recipient-address-list + (current-buffer))) + (error "Sending failed: %s" + (smtpmail--sanitize-error-message result)))))) (delete-file file-data) (delete-file file-elisp) (delete-region (point-at-bol) (point-at-bol 2))) @@ -485,17 +516,10 @@ for `smtpmail-try-auth-method'.") (defun smtpmail-maybe-append-domain (recipient) (if (or (not smtpmail-sendto-domain) - (string-match "@" recipient)) + (string-search "@" recipient)) recipient (concat recipient "@" smtpmail-sendto-domain))) -(defun smtpmail-intersection (list1 list2) - (let ((result nil)) - (dolist (el2 list2) - (when (memq el2 list1) - (push el2 result))) - (nreverse result))) - (defun smtpmail-command-or-throw (process string &optional code) (let (ret) (smtpmail-send-command process string) @@ -512,9 +536,10 @@ for `smtpmail-try-auth-method'.") (if port (format "%s" port) "smtp")) - (let* ((mechs (smtpmail-intersection + (let* ((mechs (seq-intersection + smtpmail-auth-supported (cdr-safe (assoc 'auth supported-extensions)) - smtpmail-auth-supported)) + #'eq)) (auth-source-creation-prompts '((user . "SMTP user name for %h: ") (secret . "SMTP password for %u@%h: "))) @@ -571,7 +596,7 @@ USER and PASSWORD should be non-nil." (error "Mechanism %S not implemented" mech)) (cl-defmethod smtpmail-try-auth-method - (process (_mech (eql cram-md5)) user password) + (process (_mech (eql 'cram-md5)) user password) (let ((ret (smtpmail-command-or-throw process "AUTH CRAM-MD5"))) (when (eq (car ret) 334) (let* ((challenge (substring (cadr ret) 4)) @@ -593,13 +618,13 @@ USER and PASSWORD should be non-nil." (smtpmail-command-or-throw process encoded))))) (cl-defmethod smtpmail-try-auth-method - (process (_mech (eql login)) user password) + (process (_mech (eql 'login)) user password) (smtpmail-command-or-throw process "AUTH LOGIN") (smtpmail-command-or-throw process (base64-encode-string user t)) (smtpmail-command-or-throw process (base64-encode-string password t))) (cl-defmethod smtpmail-try-auth-method - (process (_mech (eql plain)) user password) + (process (_mech (eql 'plain)) user password) ;; We used to send an empty initial request, and wait for an ;; empty response, and then send the password, but this ;; violate a SHOULD in RFC 2222 paragraph 5.1. Note that this @@ -611,6 +636,14 @@ USER and PASSWORD should be non-nil." (base64-encode-string (concat "\0" user "\0" password) t)) 235)) +(cl-defmethod smtpmail-try-auth-method + (process (_mech (eql xoauth2)) user password) + (smtpmail-command-or-throw + process + (concat "AUTH XOAUTH2 " + (base64-encode-string + (concat "user=" user "\1auth=Bearer " password "\1\1") t)))) + (defun smtpmail-response-code (string) (when string (with-temp-buffer @@ -627,7 +660,7 @@ USER and PASSWORD should be non-nil." (= code (car response))))) (defun smtpmail-response-text (response) - (mapconcat 'identity (cdr response) "\n")) + (mapconcat #'identity (cdr response) "\n")) (defun smtpmail-query-smtp-server () "Query for an SMTP server and try to contact it. @@ -667,7 +700,7 @@ Returns an error if the server cannot be contacted." (let ((parts (split-string user-mail-address "@"))) (and (= (length parts) 2) ;; There's a dot in the domain name. - (string-match "\\." (cadr parts)) + (string-search "." (cadr parts)) user-mail-address)))) (defun smtpmail-via-smtp (recipient smtpmail-text-buffer @@ -683,13 +716,17 @@ Returns an error if the server cannot be contacted." ;; `smtpmail-mail-address' should be set to the appropriate ;; buffer-local value by the caller, but in case not: (envelope-from - (or smtpmail-mail-address - (and mail-specify-envelope-from - (mail-envelope-from)) - (let ((from (mail-fetch-field "from"))) - (and from - (cadr (mail-extract-address-components from)))) - (smtpmail-user-mail-address))) + (save-restriction + ;; Only look at the headers when fetching the + ;; envelope address. + (message-narrow-to-headers) + (or smtpmail-mail-address + (and mail-specify-envelope-from + (mail-envelope-from)) + (let ((from (mail-fetch-field "from"))) + (and from + (cadr (mail-extract-address-components from)))) + (smtpmail-user-mail-address)))) process-buffer result auth-mechanisms @@ -741,7 +778,7 @@ Returns an error if the server cannot be contacted." "Unable to contact server"))) ;; set the send-filter - (set-process-filter process 'smtpmail-process-filter) + (set-process-filter process #'smtpmail-process-filter) (let* ((greeting (plist-get (cdr result) :greeting)) (code (smtpmail-response-code greeting))) @@ -1087,6 +1124,12 @@ many continuation lines." (while (and (looking-at "^[ \t].*\n") (< (point) header-end)) (replace-match "")))))) +;; Obsolete. + +(defun smtpmail-intersection (list1 list2) + (declare (obsolete seq-intersection "28.1")) + (seq-intersection list2 list1 #'eq)) + (provide 'smtpmail) ;;; smtpmail.el ends here diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index 99ac41dd9ba..d545b0c3f15 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -1,4 +1,4 @@ -;;; supercite.el --- minor mode for citing mail and news replies +;;; supercite.el --- minor mode for citing mail and news replies -*- lexical-binding: t; -*- ;; Copyright (C) 1993, 1997, 2001-2021 Free Software Foundation, Inc. @@ -527,71 +527,71 @@ string." (defvar sc-T-keymap (let ((map (make-sparse-keymap))) - (define-key map "a" 'sc-S-preferred-attribution-list) - (define-key map "b" 'sc-T-mail-nuke-blank-lines) - (define-key map "c" 'sc-T-confirm-always) - (define-key map "d" 'sc-T-downcase) - (define-key map "e" 'sc-T-electric-references) - (define-key map "f" 'sc-T-auto-fill-region) - (define-key map "h" 'sc-T-describe) - (define-key map "l" 'sc-S-cite-region-limit) - (define-key map "n" 'sc-S-mail-nuke-mail-headers) - (define-key map "N" 'sc-S-mail-header-nuke-list) - (define-key map "o" 'sc-T-electric-circular) - (define-key map "p" 'sc-S-preferred-header-style) - (define-key map "s" 'sc-T-nested-citation) - (define-key map "u" 'sc-T-use-only-preferences) - (define-key map "w" 'sc-T-fixup-whitespace) - (define-key map "?" 'sc-T-describe) + (define-key map "a" #'sc-S-preferred-attribution-list) + (define-key map "b" #'sc-T-mail-nuke-blank-lines) + (define-key map "c" #'sc-T-confirm-always) + (define-key map "d" #'sc-T-downcase) + (define-key map "e" #'sc-T-electric-references) + (define-key map "f" #'sc-T-auto-fill-region) + (define-key map "h" #'sc-T-describe) + (define-key map "l" #'sc-S-cite-region-limit) + (define-key map "n" #'sc-S-mail-nuke-mail-headers) + (define-key map "N" #'sc-S-mail-header-nuke-list) + (define-key map "o" #'sc-T-electric-circular) + (define-key map "p" #'sc-S-preferred-header-style) + (define-key map "s" #'sc-T-nested-citation) + (define-key map "u" #'sc-T-use-only-preferences) + (define-key map "w" #'sc-T-fixup-whitespace) + (define-key map "?" #'sc-T-describe) map) "Keymap for sub-keymap of setting and toggling functions.") (defvar sc-mode-map (let ((map (make-sparse-keymap))) - (define-key map "c" 'sc-cite-region) - (define-key map "f" 'sc-mail-field-query) - (define-key map "g" 'sc-mail-process-headers) - (define-key map "h" 'sc-describe) - (define-key map "i" 'sc-insert-citation) - (define-key map "o" 'sc-open-line) - (define-key map "r" 'sc-recite-region) - (define-key map "\C-p" 'sc-raw-mode-toggle) - (define-key map "u" 'sc-uncite-region) - (define-key map "w" 'sc-insert-reference) - (define-key map "\C-t" sc-T-keymap) - (define-key map "?" 'sc-describe) + (define-key map "c" #'sc-cite-region) + (define-key map "f" #'sc-mail-field-query) + (define-key map "g" #'sc-mail-process-headers) + (define-key map "h" #'sc-describe) + (define-key map "i" #'sc-insert-citation) + (define-key map "o" #'sc-open-line) + (define-key map "r" #'sc-recite-region) + (define-key map "\C-p" #'sc-raw-mode-toggle) + (define-key map "u" #'sc-uncite-region) + (define-key map "w" #'sc-insert-reference) + (define-key map "\C-t" sc-T-keymap) + (define-key map "?" #'sc-describe) map) "Keymap for Supercite quasi-mode.") (defvar sc-electric-mode-map (let ((map (make-sparse-keymap))) - (define-key map "p" 'sc-eref-prev) - (define-key map "n" 'sc-eref-next) - (define-key map "s" 'sc-eref-setn) - (define-key map "j" 'sc-eref-jump) - (define-key map "x" 'sc-eref-abort) - (define-key map "q" 'sc-eref-abort) - (define-key map "\r" 'sc-eref-exit) - (define-key map "\n" 'sc-eref-exit) - (define-key map "g" 'sc-eref-goto) - (define-key map "?" 'describe-mode) - (define-key map "\C-h" 'describe-mode) - (define-key map [f1] 'describe-mode) - (define-key map [help] 'describe-mode) + (define-key map "p" #'sc-eref-prev) + (define-key map "n" #'sc-eref-next) + (define-key map "s" #'sc-eref-setn) + (define-key map "j" #'sc-eref-jump) + (define-key map "x" #'sc-eref-abort) + (define-key map "q" #'sc-eref-abort) + (define-key map "\r" #'sc-eref-exit) + (define-key map "\n" #'sc-eref-exit) + (define-key map "g" #'sc-eref-goto) + (define-key map "?" #'describe-mode) + (define-key map "\C-h" #'describe-mode) + (define-key map [f1] #'describe-mode) + (define-key map [help] #'describe-mode) map) "Keymap for `sc-electric-mode' electric references mode.") (defvar sc-minibuffer-local-completion-map (let ((map (copy-keymap minibuffer-local-completion-map))) - (define-key map "\C-t" 'sc-toggle-fn) - (define-key map " " 'self-insert-command) + (define-key map "\C-t" #'sc-toggle-fn) + (define-key map " " #'self-insert-command) map) "Keymap for minibuffer confirmation of attribution strings.") (defvar sc-minibuffer-local-map (let ((map (copy-keymap minibuffer-local-map))) - (define-key map "\C-t" 'sc-toggle-fn) + (define-key map "\C-t" #'sc-toggle-fn) map) "Keymap for minibuffer confirmation of attribution strings.") @@ -1109,6 +1109,8 @@ Only used during confirmation." (setq sc-attrib-or-cite (not sc-attrib-or-cite)) (throw 'sc-reconfirm t)) +(defvar completer-disable) ;; From some `completer.el' package. + (defun sc-select-attribution () "Select an attribution from `sc-attributions'. @@ -1126,6 +1128,8 @@ selection but before querying is performed. During auto-selected citation string and the variable `attribution' is bound to the auto-selected attribution string." (run-hooks 'sc-attribs-preselect-hook) + (with-suppressed-warnings ((lexical citation attribution)) + (defvar citation) (defvar attribution)) (let ((query-p sc-confirm-always-p) attribution citation (attriblist sc-preferred-attribution-list)) @@ -1150,7 +1154,7 @@ to the auto-selected attribution string." (setq attribution attrib attriblist nil)) ((listp attrib) - (setq attribution (eval attrib)) + (setq attribution (eval attrib t)) (if (stringp attribution) (setq attriblist nil) (setq attribution nil @@ -1593,7 +1597,7 @@ error occurs." (let ((ref (nth sc-eref-style sc-rewrite-header-list))) (condition-case err (progn - (eval ref) + (eval ref t) (let ((lines (count-lines (point-min) (point-max)))) (or nomsg (message "Ref header %d [%d line%s]: %s" sc-eref-style lines @@ -1767,8 +1771,7 @@ 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." - (let* ((minibuffer-help-form '(funcall myhelp)) - (myhelp + (let* ((myhelp (lambda () (with-output-to-temp-buffer "*Help*" (prin1 var) @@ -1784,7 +1787,8 @@ help window." 1)) (with-current-buffer standard-output (help-mode)) - nil)))) + nil))) + (minibuffer-help-form `(funcall #',myhelp))) (set var (eval-minibuffer (format "Set %s to value: " var))))) (defmacro sc-toggle-symbol (rootname) diff --git a/lisp/mail/uce.el b/lisp/mail/uce.el index a573c8a2673..b07004de38c 100644 --- a/lisp/mail/uce.el +++ b/lisp/mail/uce.el @@ -1,4 +1,4 @@ -;;; uce.el --- facilitate reply to unsolicited commercial email +;;; uce.el --- facilitate reply to unsolicited commercial email -*- lexical-binding: t; -*- ;; Copyright (C) 1996, 1998, 2000-2021 Free Software Foundation, Inc. @@ -127,14 +127,12 @@ "A symbol indicating which mail reader you are using. Choose from: `gnus', `rmail'." :type '(choice (const gnus) (const rmail)) - :version "20.3" - :group 'uce) + :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 - :group 'uce) + :type 'hook) (defcustom uce-message-text "Recently, I have received an Unsolicited Commercial E-mail from you. @@ -180,36 +178,31 @@ 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) - :group 'uce) + :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) - :group 'uce) + :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) - :group 'uce) + :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) - :group 'uce) + :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 - :group 'uce) + :type 'string) ;; End of user options. @@ -221,7 +214,7 @@ These are mostly meant for headers that prevent delivery errors reporting." (declare-function rmail-toggle-header "rmail" (&optional arg)) ;;;###autoload -(defun uce-reply-to-uce (&optional ignored) +(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. @@ -253,10 +246,10 @@ You might need to set `uce-mail-reader' before using this." (if reply-to (setq to (format "%s, %s" to (mail-strip-quoted-names reply-to)))) (let (first-at-sign end-of-hostname sender-host) - (setq first-at-sign (string-match "@" to) + (setq first-at-sign (string-search "@" to) end-of-hostname (string-match "[ ,>]" to first-at-sign) sender-host (substring to first-at-sign end-of-hostname)) - (if (string-match "\\." sender-host) + (if (string-search "." sender-host) (setq to (format "%s, postmaster%s, abuse%s" to sender-host sender-host)))) (setq mail-send-actions nil) @@ -298,7 +291,7 @@ You might need to set `uce-mail-reader' before using this." (search-forward " ") (forward-char -1) ;; And add its postmaster to the list of addresses. - (if (string-match "\\." (buffer-substring temp (point))) + (if (string-search "." (buffer-substring temp (point))) (setq to (format "%s, postmaster@%s" to (buffer-substring temp (point))))) ;; Also look at the message-id, it helps *very* often. @@ -309,7 +302,7 @@ You might need to set `uce-mail-reader' before using this." (setq temp (point)) (search-forward ">") (forward-char -1) - (if (string-match "\\." (buffer-substring temp (point))) + (if (string-search "." (buffer-substring temp (point))) (setq to (format "%s, postmaster@%s" to (buffer-substring temp (point))))))) (when (eq uce-mail-reader 'gnus) @@ -367,7 +360,7 @@ You might need to set `uce-mail-reader' before using this." ;; functions in mail-mode, etc. (run-hooks 'mail-setup-hook 'uce-setup-hook)))) -(defun uce-insert-ranting (&optional ignored) +(defun uce-insert-ranting (&optional _ignored) "Insert text of the usual reply to UCE into current buffer." (interactive "P") (insert uce-message-text)) diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el index bf57ed6fa6f..0760a477296 100644 --- a/lisp/mail/undigest.el +++ b/lisp/mail/undigest.el @@ -125,7 +125,7 @@ See rmail-digest-methods." ;; Undo masking of separators inside digestified messages (goto-char (point-min)) (while (search-forward - (replace-regexp-in-string "\n-" "\n " separator) nil t) + (string-replace "\n-" "\n " separator) nil t) (replace-match separator)) ;; Return the list of marker pairs (nreverse result)))))) diff --git a/lisp/mail/unrmail.el b/lisp/mail/unrmail.el index 34de416c959..5b1abd54c6f 100644 --- a/lisp/mail/unrmail.el +++ b/lisp/mail/unrmail.el @@ -1,4 +1,4 @@ -;;; unrmail.el --- convert Rmail Babyl files to mbox files +;;; unrmail.el --- convert Rmail Babyl files to mbox files -*- lexical-binding: t; -*- ;; Copyright (C) 1992, 2001-2021 Free Software Foundation, Inc. @@ -235,7 +235,7 @@ The variable `unrmail-mbox-format' controls which mbox format to use." ;; Insert the `From ' line. (insert mail-from) ;; Record the keywords and attributes in our special way. - (insert "X-RMAIL-ATTRIBUTES: " (apply 'string attrs) "\n") + (insert "X-RMAIL-ATTRIBUTES: " (apply #'string attrs) "\n") (when keywords (insert "X-RMAIL-KEYWORDS: " keywords "\n")) ;; Convert From to >From, etc. diff --git a/lisp/mail/uudecode.el b/lisp/mail/uudecode.el index fdd402e0fa0..026356efe97 100644 --- a/lisp/mail/uudecode.el +++ b/lisp/mail/uudecode.el @@ -1,4 +1,4 @@ -;;; uudecode.el -- elisp native uudecode -*- lexical-binding:t -*- +;;; uudecode.el --- elisp native uudecode -*- lexical-binding:t -*- ;; Copyright (C) 1998-2021 Free Software Foundation, Inc. |