# HG changeset patch # User Reiner Steib # Date 1093966783 0 # Node ID 80f0490297cbdf5aed75cded7ea35d3f04773f3d # Parent e300f00a427a6fc6e882b51b6f0344dc7d109541 [ Merge from Gnus v5-10 branch. See the tags "gnus-5_10-pre-merge-josefsson" and "gnus-5_10-post-merge-josefsson". ] 2004-08-31 Jesper Harder * message.el (message-idna-to-ascii-rhs-1): Don't choke on invalid addresses. 2004-08-31 Reiner Steib * message.el (message-idna-to-ascii-rhs-1): Fix typo. 2004-08-31 Lars Magne Ingebrigtsen * message.el (message-idna-to-ascii-rhs-1): Don't use equalp. 2004-08-31 Lars Magne Ingebrigtsen * gnus-art.el (article-decode-idna-rhs): Don't use message-idna-inside-rhs-p. 2004-08-31 Lars Magne Ingebrigtsen * message.el (message-idna-inside-rhs-p): Removed. (message-idna-to-ascii-rhs-1): Use proper address parsing. diff -r e300f00a427a -r 80f0490297cb lisp/gnus/message.el --- a/lisp/gnus/message.el Tue Aug 31 15:38:25 2004 +0000 +++ b/lisp/gnus/message.el Tue Aug 31 15:39:43 2004 +0000 @@ -1532,6 +1532,7 @@ :type 'regexp) (eval-and-compile + (autoload 'idna-to-ascii "idna") (autoload 'message-setup-toolbar "messagexmas") (autoload 'mh-new-draft-name "mh-comp") (autoload 'mh-send-letter "mh-comp") @@ -4878,57 +4879,25 @@ list msg-recipients)))))) -(defun message-idna-inside-rhs-p () - "Return t iff point is inside a RHS (heuristically). -Only works properly if header contains mailbox-list or address-list. -I.e., calling it on a Subject: header is useless." - (save-restriction - (narrow-to-region (save-excursion (or (re-search-backward "^[^ \t]" nil t) - (point-min))) - (save-excursion (or (re-search-forward "^[^ \t]" nil t) - (point-max)))) - (if (re-search-backward "[\\\n\r\t ]" - (save-excursion (search-backward "@" nil t)) t) - ;; whitespace between @ and point - nil - (let ((dquote 1) (paren 1)) - (while (save-excursion (re-search-backward "[^\\]\"" nil t dquote)) - (incf dquote)) - (while (save-excursion (re-search-backward "[^\\]\(" nil t paren)) - (incf paren)) - (and (= (% dquote 2) 1) (= (% paren 2) 1)))))) - -(autoload 'idna-to-ascii "idna") - (defun message-idna-to-ascii-rhs-1 (header) "Interactively potentially IDNA encode domain names in HEADER." - (let (rhs ace start startpos endpos ovl) - (goto-char (point-min)) - (while (re-search-forward (concat "^" header) nil t) - (while (re-search-forward "@\\([^ \t\r\n>,]+\\)" - (or (save-excursion - (re-search-forward "^[^ \t]" nil t)) - (point-max)) - t) - (setq rhs (match-string-no-properties 1) - startpos (match-beginning 1) - endpos (match-end 1)) - (when (save-match-data - (and (message-idna-inside-rhs-p) - (setq ace (idna-to-ascii rhs)) - (not (string= rhs ace)) - (if (eq message-use-idna 'ask) - (unwind-protect - (progn - (setq ovl (message-make-overlay startpos - endpos)) - (message-overlay-put ovl 'face 'highlight) - (y-or-n-p - (format "Replace with `%s'? " ace))) - (message "") - (message-delete-overlay ovl)) - message-use-idna))) - (replace-match (concat "@" ace))))))) + (let ((field (message-fetch-field header)) + rhs ace address) + (when field + (dolist (address (mail-header-parse-addresses field)) + (setq address (car address) + rhs (downcase (or (cadr (split-string address "@")) "")) + ace (downcase (idna-to-ascii rhs))) + (when (and (not (equal rhs ace)) + (or (not (eq message-use-idna 'ask)) + (y-or-n-p (format "Replace %s with %s? " rhs ace)))) + (goto-char (point-min)) + (while (re-search-forward (concat "^" header ":") nil t) + (message-narrow-to-field) + (while (search-forward (concat "@" rhs) nil t) + (replace-match (concat "@" ace) t t)) + (goto-char (point-max)) + (widen))))))) (defun message-idna-to-ascii-rhs () "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.