# HG changeset patch # User Paul Reilly # Date 1016566966 0 # Node ID 55bcbf42cf3fc7c9a1dc814025b664ed597cb7ec # Parent 5766d225ccf31c42eebb6665c92dd5e3e59e2869 (rmail-dont-reply-to): Overhaul to correctly apply the regular expressions in the variable `rmail-dont-reply-to-names' to the list of destination addresses. Contributed by lorentey@elte.hu. diff -r 5766d225ccf3 -r 55bcbf42cf3f lisp/mail/mail-utils.el --- a/lisp/mail/mail-utils.el Tue Mar 19 19:35:31 2002 +0000 +++ b/lisp/mail/mail-utils.el Tue Mar 19 19:42:46 2002 +0000 @@ -197,63 +197,59 @@ nil 'literal address 2))) address)))) -; rmail-dont-reply-to-names is defined in loaddefs -(defun rmail-dont-reply-to (userids) - "Returns string of mail addresses USERIDS sans any recipients -that start with matches for `rmail-dont-reply-to-names'. -Usenet paths ending in an element that matches are removed also." +;;; 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) + "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." (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 "\\|") - "") - (concat (regexp-quote (user-login-name)) - "\\>")))) - (let ((match (concat "\\(^\\|,\\)[ \t\n]*" - ;; Can anyone figure out what this is for? - ;; Is it an obsolete remnant of another way of - ;; handling Foo Bar ? - "\\([^,\n]*[!<]\\|\\)" - "\\(" - rmail-dont-reply-to-names - "\\|" - ;; Include the human name that precedes . - "\\([^\,.<\"]\\|\"[^\"]*\"\\)*" - "<\\(" rmail-dont-reply-to-names "\\)" - "\\)[^,]*")) - (case-fold-search t) - pos epos) - (while (and (setq pos (string-match match userids pos)) - (> (length userids) 0)) - ;; If there's a match, it starts at the beginning of the string, - ;; or with `,'. We must delete from that position to the - ;; end of the user-id which starts at match-beginning 2. - (let (inside-quotes quote-pos last-quote-pos) - (save-match-data - (while (and (setq quote-pos (string-match "\"" userids quote-pos)) - (< quote-pos pos)) - (setq last-quote-pos quote-pos) - (setq quote-pos (1+ quote-pos)) - (setq inside-quotes (not inside-quotes)))) - (if inside-quotes - (if (string-match "\"" userids pos) - (setq pos (string-match "\"" userids pos)) + "") + (if (and user-mail-address + (not (equal user-mail-address user-login-name))) + (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)) + (while start-pos + (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)))) + (if next-pos + (setq cur-pos (1+ next-pos)) ;; If the open-quote has no close-quote, ;; delete the open-quote to get something well-defined. ;; This case is not valid, but it can happen if things ;; are weird elsewhere. - (setq userids (replace-match "" nil nil userids)) - (setq userids (concat (substring userids 0 last-quote-pos) - (substring userids (1+ last-quote-pos)))) - (setq pos (1- pos))) - (setq userids (replace-match "" nil nil userids))))) - ;; get rid of any trailing commas - (if (setq pos (string-match "[ ,\t\n]*\\'" userids)) - (setq userids (substring userids 0 pos))) - ;; remove leading spaces. they bother me. - (if (string-match "\\(\\s \\|,\\)*" userids) - (substring userids (match-end 0)) - userids))) + (setq destinations (concat (substring destinations 0 cur-pos) + (substring destinations (1+ cur-pos)))) + (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) + (setq destinations (concat (substring destinations 0 start-pos) + (and cur-pos (substring destinations + (1+ cur-pos)))) + cur-pos start-pos) + (setq cur-pos (and cur-pos (1+ cur-pos)) + start-pos cur-pos)))))) + ;; get rid of any trailing commas + (if (setq pos (string-match "[ ,\t\n]*\\'" destinations)) + (setq destinations (substring destinations 0 pos))) + ;; remove leading spaces. they bother me. + (if (string-match "\\(\\s \\|,\\)*" destinations) + (substring destinations (match-end 0)) + destinations)) ;;;###autoload