[mail-lib] Synch with FSF 20.5 (was Re: Bad addresses in wide reply.)

Shenghuo ZHU <zsh(a)cs.rochester.edu&gt; writes: This patch fixes the problem. 2000-01-05 Yoshiki Hayashi <t90553(a)mail.ecc.u-tokyo.ac.jp&gt; * mail-utils.el: Synch with FSF 20.5. Index: mail-utils.el =================================================================== RCS file: /usr/CVSroot/XEmacs/xemacs-packages/libs/mail-lib/mail-utils.el,v retrieving revision 1.2 diff -u -r1.2 mail-utils.el --- mail-utils.el 1998/05/01 16:05:51 1.2 +++ mail-utils.el 2000/01/03 02:49:39 ＠＠ -22,7 +22,7 ＠＠ ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, ;; Boston, MA 02111-1307, USA. -;;; Synched up with: FSF 19.30. +;;; Synched up with: FSF 20.5. ;;; Commentary: ＠＠ -36,10 +36,12 ＠＠ (require 'lisp-mode) ;;;###autoload -(defvar mail-use-rfc822 nil "\ +(defcustom mail-use-rfc822 nil "\ *If non-nil, use a full, hairy RFC822 parser on mail addresses. Otherwise, (the default) use a smaller, somewhat faster, and -often correct parser.") +often correct parser." + :type 'boolean + :group 'mail) ;; Returns t if file FILE is an Rmail file. ;;;###autoload ＠＠ -73,15 +75,9 ＠＠ (progn (require 'rfc822) (mapconcat 'identity (rfc822-addresses address) ", ")) (let (pos) - (string-match "\\`[ \t\n]*" address) - ;; strip surrounding whitespace - (setq address (substring address - (match-end 0) - (string-match "[ \t\n]*\\'" address - (match-end 0)))) ;; Detect nested comments. - (if (string-match "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*(" address) + (if (string-match "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*(" address) ;; Strip nested comments. (save-excursion (set-buffer (get-buffer-create " *temp*")) ＠＠ -104,16 +100,23 ＠＠ (while (setq pos (string-match ;; This doesn't hack rfc822 nested comments ;; `(xyzzy (foo) whinge)' properly. Big deal. - "[ \t]*(\\([^)\"\\]\\|\\\\.\\|\\\\\n\\)*)" + "[ \t]*(\\([^)\\]\\|\\\\.\\|\\\\\n\\)*)" address)) (setq address (mail-string-delete address pos (match-end 0))))) + ;; strip surrounding whitespace + (string-match "\\`[ \t\n]*" address) + (setq address (substring address + (match-end 0) + (string-match "[ \t\n]*\\'" address + (match-end 0)))) + ;; strip `quoted' names (This is supposed to hack `"Foo Bar" <bar＠host>') (setq pos 0) (while (setq pos (string-match - "[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*" + "\\([ \t]?\\)[ \t]*\"\\([^\"\\]\\|\\\\.\\|\\\\\n\\)*\"[ \t\n]*" address pos)) ;; If the next thing is "＠", we have "foo bar"＠host. Leave it. (if (and (> (length address) (match-end 0)) ＠＠ -121,9 +124,9 ＠＠ (setq pos (match-end 0)) (setq address (mail-string-delete address - pos (match-end 0))))) + (match-end 1) (match-end 0))))) ;; Retain only part of address in <> delims, if there is such a thing. - (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,]*>\\)" + (while (setq pos (string-match "\\(,\\s-*\\|\\`\\)[^,]*<\\([^>,:]*>\\)" address)) (let ((junk-beg (match-end 1)) (junk-end (match-beginning 2)) ＠＠ -133,16 +136,9 ＠＠ (if (fboundp mail-rewrite-address-function) (funcall mail-rewrite-address-function address) address))))) - -(or (and (boundp 'rmail-default-dont-reply-to-names) - (not (null rmail-default-dont-reply-to-names))) - (setq rmail-default-dont-reply-to-names "info-")) -;;;###autoload -(defvar rmail-dont-reply-to-names nil "\ -*A regexp specifying names to prune of reply to messages. -A value of nil means exclude your own name only.") +;; rmail-dont-reply-to-names is an autoloaded variable in rmail-mini.el (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'. ＠＠ -154,21 +150,40 ＠＠ "") (concat (regexp-quote (user-login-name)) "\\>")))) - (let ((match (concat "\\(^\\|,\\)[ \t\n]*\\([^,\n]*[!<]\\|\\)\\(" - rmail-dont-reply-to-names + (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 <foo＠machine>? + "\\([^,\n]*[!<]\\|\\)" + "\\(" + rmail-dont-reply-to-names + "\\|" + ;; Include the human name that precedes <foo＠bar>. + "\\([^\,.<\"]\\|\"[^\"]*\"\\)*" + "<\\(" rmail-dont-reply-to-names "\\)" "\\)")) (case-fold-search t) pos epos) - (while (setq pos (string-match match userids)) + (while (setq pos (string-match match userids pos)) (if (> pos 0) (setq pos (match-beginning 2))) (setq epos ;; Delete thru the next comma, plus whitespace after. - (if (string-match ",[ \t\n]+" userids (match-end 0)) + (if (string-match ",[ \t\n]*" userids (match-end 0)) (match-end 0) (length userids))) - (setq userids - (mail-string-delete - userids pos epos))) + ;; Count the double-quotes since the beginning of the list. + ;; Reject this match if it is inside a pair of doublequotes. + (let (quote-pos inside-quotes) + (while (and (setq quote-pos (string-match "\"" userids quote-pos)) + (< quote-pos pos)) + (setq quote-pos (1+ quote-pos)) + (setq inside-quotes (not inside-quotes))) + (if inside-quotes + ;; Advance to next even-parity quote, and scan from there. + (setq pos (string-match "\"" userids pos)) + (setq userids + (mail-string-delete + userids pos epos))))) ;; get rid of any trailing commas (if (setq pos (string-match "[ ,\t\n]*\\'" userids)) (setq userids (substring userids 0 pos))) ＠＠ -178,30 +193,36 ＠＠ userids)))  ;;;###autoload -(defun mail-fetch-field (field-name &optional last all) - "Return the value of the header field FIELD-NAME. -The buffer is expected to be narrowed to just the headers of the message. -If second arg LAST is non-nil, use the last such field if there are several. -If third arg ALL is non-nil, concatenate all such fields with commas between." +(defun mail-fetch-field (field-name &optional last all list) + "Return the value of the header field whose type is FIELD-NAME. +The buffer is expected to be narrowed to just the header of the message. +If second arg LAST is non-nil, use the last field of type FIELD-NAME. +If third arg ALL is non-nil, concatenate all such fields with commas between. +If 4th arg LIST is non-nil, return a list of all such fields." (save-excursion (goto-char (point-min)) (let ((case-fold-search t) (name (concat "^" (regexp-quote field-name) "[ \t]*:[ \t]*"))) - (if all - (let ((value "")) + (if (or all list) + (let ((value (if all ""))) (while (re-search-forward name nil t) (let ((opoint (point))) (while (progn (forward-line 1) (looking-at "[ \t]"))) ;; Back up over newline, then trailing spaces or tabs (forward-char -1) - (while (member (preceding-char) '(? ?\t)) - (forward-char -1)) - (setq value (concat value - (if (string= value "") "" ", ") - (buffer-substring-no-properties - opoint (point)))))) - (and (not (string= value "")) value)) + (skip-chars-backward " \t" opoint) + (if list + (setq value (cons (buffer-substring-no-properties + opoint (point)) + value)) + (setq value (concat value + (if (string= value "") "" ", ") + (buffer-substring-no-properties + opoint (point))))))) + (if list + value + (and (not (string= value "")) value))) (if (re-search-forward name nil t) (progn (if last (while (re-search-forward name nil t))) ＠＠ -210,8 +231,7 ＠＠ (looking-at "[ \t]"))) ;; Back up over newline, then trailing spaces or tabs (forward-char -1) - (while (member (preceding-char) '(? ?\t)) - (forward-char -1)) + (skip-chars-backward " \t" opoint) (buffer-substring-no-properties opoint (point)))))))))  ;; Parse a list of tokens separated by commas. ＠＠ -227,7 +247,7 ＠＠ (skip-chars-forward "^,") (skip-chars-backward " \t\n") (setq accumulated - (cons (buffer-substring beg (point)) + (cons (buffer-substring-no-properties beg (point)) accumulated)) (skip-chars-forward "^,") (skip-chars-forward ", \t\n")) -- Yoshiki Hayashi