X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/7c82f3e23e37cc848a38b1f8be7149fd672a6393..0e963201d03d9229bb8ac4323291d2b0119526ed:/lisp/mail/mail-utils.el diff --git a/lisp/mail/mail-utils.el b/lisp/mail/mail-utils.el index 1e9412cb7a..b65171903c 100644 --- a/lisp/mail/mail-utils.el +++ b/lisp/mail/mail-utils.el @@ -1,9 +1,8 @@ ;;; mail-utils.el --- utility functions used both by rmail and rnews -;; Copyright (C) 1985, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, -;; 2009, 2010, 2011 Free Software Foundation, Inc. +;; Copyright (C) 1985, 2001-2016 Free Software Foundation, Inc. -;; Maintainer: FSF +;; Maintainer: emacs-devel@gnu.org ;; Keywords: mail, news ;; This file is part of GNU Emacs. @@ -36,13 +35,25 @@ often correct parser." :type 'boolean :group 'mail) +;;;###autoload +(defcustom mail-dont-reply-to-names nil + "Regexp specifying addresses to prune from a reply message. +If this is nil, it is set the first time you compose a reply, to +a value which excludes your own email address. + +Matching addresses are excluded from the CC field in replies, and +also the To field, unless this would leave an empty To field." + :type '(choice regexp (const :tag "Your Name" nil)) + :group 'mail) + ;; Returns t if file FILE is an Rmail file. ;;;###autoload (defun mail-file-babyl-p (file) "Return non-nil if FILE is a Babyl file." - (with-temp-buffer - (insert-file-contents file nil 0 100) - (looking-at "BABYL OPTIONS:"))) + (let ((epa-inhibit t)) + (with-temp-buffer + (insert-file-contents file nil 0 100) + (looking-at "BABYL OPTIONS:")))) (defun mail-string-delete (string start end) "Returns a string containing all of STRING except the part @@ -53,12 +64,16 @@ from START (inclusive) to END (exclusive)." ;;;###autoload (defun mail-quote-printable (string &optional wrapper) - "Convert a string to the \"quoted printable\" Q encoding. + "Convert a string to the \"quoted printable\" Q encoding if necessary. +If the string contains only ASCII characters and no troublesome ones, +we return it unconverted. + If the optional argument WRAPPER is non-nil, we add the wrapper characters =?ISO-8859-1?Q?....?=." (let ((i 0) (result "")) (save-match-data - (while (string-match "[?=\"\200-\377]" string i) + (while (or (string-match "[?=\"]" string i) + (string-match "[^\000-\177]" string i)) (setq result (concat result (substring string i (match-beginning 0)) (upcase (format "=%02x" @@ -169,17 +184,15 @@ as Rmail does." (error "Malformed MIME quoted-printable message")))) (not failed)))))) -(eval-when-compile (require 'rfc822)) +(autoload 'rfc822-addresses "rfc822") (defun mail-strip-quoted-names (address) "Delete comments and quoted strings in an address list ADDRESS. Also delete leading/trailing whitespace and replace FOO with just BAR. Return a modified address list." - (if (null address) - nil + (when address (if mail-use-rfc822 - (progn (require 'rfc822) - (mapconcat 'identity (rfc822-addresses address) ", ")) + (mapconcat 'identity (rfc822-addresses address) ", ") (let (pos) ;; Strip comments. @@ -214,36 +227,31 @@ Return a modified address list." nil 'literal address 2))) address)))) -;; The following piece of ugliness is legacy code. The name was an -;; unfortunate choice --- a flagrant violation of the Emacs Lisp -;; coding conventions. `mail-dont-reply-to' would have been -;; infinitely better. Also, `rmail-dont-reply-to-names' might have -;; been better named `mail-dont-reply-to-names' and sourced from this -;; file instead of in rmail.el. Yuck. -pmr -(defun rmail-dont-reply-to (destinations) +(defun mail-dont-reply-to (destinations) "Prune addresses from DESTINATIONS, a list of recipient addresses. -All addresses matching `rmail-dont-reply-to-names' are removed from -the comma-separated list. The pruned list is returned." +Remove all addresses matching `mail-dont-reply-to-names' from the +comma-separated list, and return the pruned list." ;; FIXME this (setting a user option the first time a command is used) ;; is somewhat strange. Normally one would never set the option, ;; but instead fall back to the default so long as it was nil. ;; Or just set the default directly in the defcustom. - (if (null rmail-dont-reply-to-names) - (setq rmail-dont-reply-to-names - (concat (if rmail-default-dont-reply-to-names - (concat rmail-default-dont-reply-to-names "\\|") - "") - (if (and user-mail-address - (not (equal user-mail-address user-login-name))) - ;; Anchor the login name and email address so - ;; that we don't match substrings: if the - ;; login name is "foo", we shouldn't match - ;; "barfoo@baz.com". - (concat "\\`" - (regexp-quote user-mail-address) - "\\'\\|") - "") - (concat "\\`" (regexp-quote user-login-name) "@")))) + (if (null mail-dont-reply-to-names) + (setq mail-dont-reply-to-names + (concat + ;; `rmail-default-dont-reply-to-names' is obsolete. + (if (bound-and-true-p rmail-default-dont-reply-to-names) + (concat rmail-default-dont-reply-to-names "\\|") + "") + (if (and user-mail-address + (not (equal user-mail-address user-login-name))) + ;; Anchor the login name and email address so that we + ;; don't match substrings: if the login name is + ;; "foo", we shouldn't match "barfoo@baz.com". + (concat "\\`" + (regexp-quote user-mail-address) + "\\'\\|") + "") + (concat "\\`" (regexp-quote user-login-name) "@")))) ;; Split up DESTINATIONS and match each element separately. (let ((start-pos 0) (cur-pos 0) (case-fold-search t)) @@ -263,7 +271,7 @@ the comma-separated list. The pruned list is returned." (setq cur-pos start-pos))) (let* ((address (substring destinations start-pos cur-pos)) (naked-address (mail-strip-quoted-names address))) - (if (string-match rmail-dont-reply-to-names naked-address) + (if (string-match mail-dont-reply-to-names naked-address) (setq destinations (concat (substring destinations 0 start-pos) (and cur-pos (substring destinations (1+ cur-pos)))) @@ -279,6 +287,9 @@ the comma-separated list. The pruned list is returned." (substring destinations (match-end 0)) destinations)) +;; Legacy name +(define-obsolete-function-alias 'rmail-dont-reply-to 'mail-dont-reply-to "24.1") + ;;;###autoload (defun mail-fetch-field (field-name &optional last all list)