1 ;;; gnus-idna.el --- Internationalized domain names support for Gnus.
3 ;; Copyright (C) 2003 Free Software Foundation, Inc.
5 ;; Author: Simon Josefsson
6 ;; Keywords: news, mail
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
27 ;; This package implement crude support for internationalized
28 ;; (non-ASCII) domain names in Gnus. It is meant as a proof of
31 ;; Theory of Operation:
33 ;; RFC 2822 RHS's inside the From:, To:, and CC: headers are encoded
34 ;; using IDNA ToASCII() when you send mail using Message. The hook
35 ;; used is message-send-hook.
37 ;; For incoming articles, when QP in headers are decoded, it searches
38 ;; for "xn--" prefixes and decode them using IDNA ToUnicode(). The
39 ;; hook used is gnus-article-decode-hook.
43 ;; Simply put (require 'gnus-idna) in your ~/.gnus or ~/.emacs and it
44 ;; should work. You need to install GNU Libidn (0.1.11 or later) and
45 ;; make sure the idna.el installed by it is found by emacs.
55 ((fboundp 'replace-in-string)
56 (defalias 'gnus-replace-in-string 'replace-in-string))
57 ((fboundp 'replace-regexp-in-string)
58 (defun gnus-replace-in-string (string regexp newtext &optional literal)
59 (replace-regexp-in-string regexp newtext string nil literal)))
61 (defun gnus-replace-in-string (string regexp newtext &optional literal)
63 (while (string-match regexp string start)
64 (setq tail (- (length string) (match-end 0)))
65 (setq string (replace-match newtext nil literal string))
66 (setq start (- (length string) tail))))
69 (defun gnus-idna-to-ascii-rhs-1 (header)
72 (let (address header-data new-header-data rhs ace)
73 (message-narrow-to-head)
74 (setq header-data (message-fetch-field header))
76 (dolist (element (message-tokenize-header header-data))
77 (setq address (car (rfc822-addresses element)))
78 (when (string-match "\\(.*\\)@\\([^@]+\\)" address)
79 (setq ace (if (setq rhs (match-string 2 address))
81 (push (if (string= rhs ace)
83 (gnus-replace-in-string
84 element (regexp-quote rhs) ace t))
86 (message-remove-header header)
87 (message-position-on-field header)
88 (dolist (addr (reverse new-header-data))
91 (delete-backward-char 2)))))))
93 (defun gnus-idna-to-ascii-rhs ()
94 (gnus-idna-to-ascii-rhs-1 "From")
95 (gnus-idna-to-ascii-rhs-1 "To")
96 (gnus-idna-to-ascii-rhs-1 "Cc"))
98 (add-hook 'message-send-hook 'gnus-idna-to-ascii-rhs)
100 (defun gnus-idna-to-unicode-rhs ()
101 (let ((inhibit-point-motion-hooks t)
103 (goto-char (point-min))
104 (while (re-search-forward "xn--.*[ \t\n\r.,<>()@!]" nil t)
105 ;(or (eobp) (forward-char))
107 (when (setq ace (match-string 0))
108 (setq unicode (idna-to-unicode ace))
109 (unless (string= ace unicode)
110 (replace-match unicode)))))))
112 (add-hook 'gnus-article-decode-hook 'gnus-idna-to-unicode-rhs 'append)
116 ;; gnus-idna.el ends here