2333 |
(autoload 'idna-to-unicode "idna") |
(autoload 'idna-to-unicode "idna") |
2334 |
|
|
2335 |
(defun article-decode-idna-rhs () |
(defun article-decode-idna-rhs () |
2336 |
"Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer." |
"Decode IDNA strings in RHS in various headers in current buffer. |
2337 |
|
The following headers are decoded: From:, To:, Cc:, Reply-To:, |
2338 |
|
Mail-Reply-To: and Mail-Followup-To:." |
2339 |
(when gnus-use-idna |
(when gnus-use-idna |
2340 |
(save-restriction |
(save-restriction |
2341 |
(let ((inhibit-point-motion-hooks t) |
(let ((inhibit-point-motion-hooks t) |
2342 |
(inhibit-read-only t)) |
(inhibit-read-only t)) |
2343 |
(article-narrow-to-head) |
(article-narrow-to-head) |
2344 |
(goto-char (point-min)) |
(goto-char (point-min)) |
2345 |
(while (re-search-forward "@.*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) |
(while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t) |
2346 |
(let (ace unicode) |
(let (ace unicode) |
2347 |
(when (save-match-data |
(when (save-match-data |
2348 |
(and (setq ace (match-string 1)) |
(and (setq ace (match-string 1)) |
2349 |
(save-excursion |
(save-excursion |
2350 |
(and (re-search-backward "^[^ \t]" nil t) |
(and (re-search-backward "^[^ \t]" nil t) |
2351 |
(looking-at "From\\|To\\|Cc"))) |
(looking-at "From\\|To\\|Cc\\|Reply-To\\|Mail-Reply-To\\|Mail-Followup-To"))) |
2352 |
(setq unicode (idna-to-unicode ace)))) |
(setq unicode (idna-to-unicode ace)))) |
2353 |
(unless (string= ace unicode) |
(unless (string= ace unicode) |
2354 |
(replace-match unicode nil nil nil 1))))))))) |
(replace-match unicode nil nil nil 1))))))))) |
4866 |
(forward-line -1) |
(forward-line -1) |
4867 |
(setq beg (point))) |
(setq beg (point))) |
4868 |
(gnus-article-insert-newline) |
(gnus-article-insert-newline) |
4869 |
(mm-insert-inline handle |
(mm-insert-inline |
4870 |
(let ((charset |
handle |
4871 |
(mail-content-type-get |
(let ((charset (mail-content-type-get (mm-handle-type handle) |
4872 |
(mm-handle-type handle) 'charset))) |
'charset))) |
4873 |
(if (eq charset 'gnus-decoded) |
(cond ((not charset) |
4874 |
(mm-get-part handle) |
(mm-string-as-multibyte (mm-get-part handle))) |
4875 |
(mm-decode-string (mm-get-part handle) |
((eq charset 'gnus-decoded) |
4876 |
charset)))) |
(with-current-buffer (mm-handle-buffer handle) |
4877 |
|
(buffer-string))) |
4878 |
|
(t |
4879 |
|
(mm-decode-string (mm-get-part handle) charset))))) |
4880 |
(goto-char (point-max)))) |
(goto-char (point-max)))) |
4881 |
;; Do highlighting. |
;; Do highlighting. |
4882 |
(save-excursion |
(save-excursion |