From: Simon Josefsson <jas@extundo.com>
Date: Wed, 26 Feb 2003 20:44:47 +0000 (+0000)
Subject: Add.
X-Git-Url: http://cgit.sxemacs.org/?a=commitdiff_plain;h=ca0d2fd5862b1c17e3aa3717f665fcc5b1a383ca;p=gnus

Add.
---

diff --git a/contrib/gnus-idna.el b/contrib/gnus-idna.el
new file mode 100644
index 000000000..e11d3a0ff
--- /dev/null
+++ b/contrib/gnus-idna.el
@@ -0,0 +1,113 @@
+;;; gnus-idna.el --- Internationalized domain names support for Gnus.
+
+;; Copyright (C) 2003 Free Software Foundation, Inc.
+
+;; Author: Simon Josefsson
+;; Keywords: news, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.	 See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package implement crude support for internationalized
+;; (non-ASCII) domain names in Gnus.  It is meant as a proof of
+;; concept.
+
+;; Theory of Operation:
+
+;; RFC 2822 RHS's inside the From:, To:, and CC: headers are encoded
+;; using IDNA ToASCII() when you send mail using Message.  The hook
+;; used is message-send-hook.
+;;
+;; For incoming articles, when QP in headers are decoded, it searches
+;; for "xn--" prefixes and decode them using IDNA ToUnicode().  The
+;; hook used is gnus-article-decode-hook.
+
+;; Usage:
+
+;; Simply put (require 'gnus-idna) in your ~/.gnus or ~/.emacs and it
+;; should work.  You need to install GNU Libidn (0.1.11 or later) and
+;; make sure the idna.el installed by it is found by emacs.
+
+;;; Code:
+
+(require 'gnus)
+(require 'rfc822)
+(require 'idna)
+
+(eval-and-compile
+  (cond
+   ((fboundp 'replace-in-string)
+    (defalias 'gnus-replace-in-string 'replace-in-string))
+   ((fboundp 'replace-regexp-in-string)
+    (defun gnus-replace-in-string  (string regexp newtext &optional literal)
+      (replace-regexp-in-string regexp newtext string nil literal)))
+   (t
+    (defun gnus-replace-in-string (string regexp newtext &optional literal)
+      (let ((start 0) tail)
+	(while (string-match regexp string start)
+	  (setq tail (- (length string) (match-end 0)))
+	  (setq string (replace-match newtext nil literal string))
+	  (setq start (- (length string) tail))))
+      string))))
+
+(defun gnus-idna-to-ascii-rhs-1 (header)
+  (save-excursion
+    (let (address header-data new-header-data rhs ace)
+      (setq header-data (message-fetch-field header))
+      (when header-data
+	(dolist (element (message-tokenize-header header-data))
+	  (setq address (car (rfc822-addresses element)))
+	  (when (string-match "\\(.*\\)@\\([^@]+\\)" address)
+	    (setq ace (if (setq rhs (match-string 2 address))
+			  (idna-to-ascii rhs)))
+	    (push (if (string= rhs ace)
+		      element
+		    (gnus-replace-in-string element (regexp-quote rhs) ace t))
+		  new-header-data)))
+	(message-remove-header header)
+	(message-position-on-field header)
+	(dolist (addr (reverse new-header-data))
+	  (insert addr ", "))
+	(when new-header-data
+	  (delete-backward-char 2))))))
+
+(defun gnus-idna-to-ascii-rhs ()
+  (gnus-idna-to-ascii-rhs-1 "From")
+  (gnus-idna-to-ascii-rhs-1 "To")
+  (gnus-idna-to-ascii-rhs-1 "Cc"))
+
+(add-hook 'message-send-hook 'gnus-idna-to-ascii-rhs)
+
+(defun gnus-idna-to-unicode-rhs ()
+  (let ((inhibit-point-motion-hooks t)
+	buffer-read-only)
+    (goto-char (point-min))
+    (while (re-search-forward "xn--.*[ \t\n\r.,<>()@!]" nil t)
+      ;(or (eobp) (forward-char))
+      (let (ace unicode)
+	(when (setq ace (match-string 0))
+	  (setq unicode (idna-to-unicode ace))
+	  (unless (string= ace unicode)
+	    (replace-match unicode)))))))
+
+(add-hook 'gnus-article-decode-hook 'gnus-idna-to-unicode-rhs 'append)
+
+(provide 'gnus-idna)
+
+;; gnus-idna.el ends here