1532 |
:type 'regexp) |
:type 'regexp) |
1533 |
|
|
1534 |
(eval-and-compile |
(eval-and-compile |
1535 |
|
(autoload 'idna-to-ascii "idna") |
1536 |
(autoload 'message-setup-toolbar "messagexmas") |
(autoload 'message-setup-toolbar "messagexmas") |
1537 |
(autoload 'mh-new-draft-name "mh-comp") |
(autoload 'mh-new-draft-name "mh-comp") |
1538 |
(autoload 'mh-send-letter "mh-comp") |
(autoload 'mh-send-letter "mh-comp") |
4879 |
list |
list |
4880 |
msg-recipients)))))) |
msg-recipients)))))) |
4881 |
|
|
|
(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") |
|
|
|
|
4882 |
(defun message-idna-to-ascii-rhs-1 (header) |
(defun message-idna-to-ascii-rhs-1 (header) |
4883 |
"Interactively potentially IDNA encode domain names in HEADER." |
"Interactively potentially IDNA encode domain names in HEADER." |
4884 |
(let (rhs ace start startpos endpos ovl) |
(let ((field (message-fetch-field header)) |
4885 |
(goto-char (point-min)) |
rhs ace address) |
4886 |
(while (re-search-forward (concat "^" header) nil t) |
(when field |
4887 |
(while (re-search-forward "@\\([^ \t\r\n>,]+\\)" |
(dolist (address (mail-header-parse-addresses field)) |
4888 |
(or (save-excursion |
(setq address (car address) |
4889 |
(re-search-forward "^[^ \t]" nil t)) |
rhs (downcase (or (cadr (split-string address "@")) "")) |
4890 |
(point-max)) |
ace (downcase (idna-to-ascii rhs))) |
4891 |
t) |
(when (and (not (equal rhs ace)) |
4892 |
(setq rhs (match-string-no-properties 1) |
(or (not (eq message-use-idna 'ask)) |
4893 |
startpos (match-beginning 1) |
(y-or-n-p (format "Replace %s with %s? " rhs ace)))) |
4894 |
endpos (match-end 1)) |
(goto-char (point-min)) |
4895 |
(when (save-match-data |
(while (re-search-forward (concat "^" header ":") nil t) |
4896 |
(and (message-idna-inside-rhs-p) |
(message-narrow-to-field) |
4897 |
(setq ace (idna-to-ascii rhs)) |
(while (search-forward (concat "@" rhs) nil t) |
4898 |
(not (string= rhs ace)) |
(replace-match (concat "@" ace) t t)) |
4899 |
(if (eq message-use-idna 'ask) |
(goto-char (point-max)) |
4900 |
(unwind-protect |
(widen))))))) |
|
(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))))))) |
|
4901 |
|
|
4902 |
(defun message-idna-to-ascii-rhs () |
(defun message-idna-to-ascii-rhs () |
4903 |
"Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. |
"Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. |