From: yamaoka Date: Mon, 12 Jan 2004 03:19:54 +0000 (+0000) Subject: *** empty log message *** X-Git-Tag: t-gnus-6_17_2-00~2 X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=fc23c18a9652ba4de29b2d15a457de101d00da8d;p=elisp%2Fgnus.git- *** empty log message *** --- diff --git a/contrib/gnus-idna.el b/contrib/gnus-idna.el deleted file mode 100644 index 15c47b6..0000000 --- a/contrib/gnus-idna.el +++ /dev/null @@ -1,154 +0,0 @@ -;;; 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 domain -;; names in Gnus. - -;; 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 (i.e., when -;; gnus-article-decode-hook is invoked), it searches for "xn--" -;; prefixes and decode them if they are found inside (heuristically -;; determined) RHS in From:, To: and Cc:, using IDNA ToUnicode(). - -;; Usage: - -;; You need to install GNU Libidn (0.1.11 or later) and make sure the -;; idna.el installed by it is found by emacs. - -;; If you use an older Gnus, you may need to put the following in your -;; init scripts too, but keep in mind that most older Gnuses either -;; doesn't have these hooks or are buggy in other regards so it -;; doesn't work anyway. (The window of Gnus versions that this works -;; on is a few weeks during the Oort CVS in winter 2003.) Update to a -;; recent Gnus instead, then you don't have to do anything. - -;; (add-hook 'message-send-hook 'message-idna-to-ascii-rhs) -;; (add-hook 'gnus-article-decode-hook 'gnus-idna-to-unicode-rhs 'append) - -;; Revision history: - -;; 2003-02-26 Initial release -;; -;; 2003-03-19 Cleanup. Fixes a bug that may corrupt outgoing mail if -;; it contains From:, To: or Cc: headers in the body. - -;;; Code: - -(require 'gnus) -(require 'gnus-util) -(require 'rfc822) -(autoload 'idna-to-ascii "idna") -(autoload 'idna-to-unicode "idna") - -(defcustom message-use-idna 'ask - "Whether to encode non-ASCII in domain names into ASCII according to IDNA." - :type '(choice (const :tag "Ask" ask) - (const :tag "Never" nil) - (const :tag "Always" t))) - -(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." - (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))))) - -(defun message-idna-to-ascii-rhs-1 (header) - "Interactively potentially IDNA encode domain names in HEADER." - (let (rhs ace start end startpos endpos) - (goto-char (point-min)) - (setq start (re-search-forward (concat "^" header) nil t) - end (or (save-excursion (re-search-forward "^[ \t]" nil t)) - (point-max))) - (when (and start end) - (while (re-search-forward "@\\([^ \t\r\n>]+\\)" end 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 - (replace-highlight startpos endpos) - (y-or-n-p - (format "Replace with `%s'? " ace))) - (message "") - (replace-dehighlight)) - message-use-idna))) - (replace-match (concat "@" ace))))))) - -;;;###autoload -(defun message-idna-to-ascii-rhs () - "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers. -See `message-idna-encode'." - (interactive) - (when (condition-case nil (require 'idna) (file-error)) - (save-excursion - (save-restriction - (message-narrow-to-head) - (message-idna-to-ascii-rhs-1 "From") - (message-idna-to-ascii-rhs-1 "To") - (message-idna-to-ascii-rhs-1 "Cc"))))) - -;;;###autoload -(defun gnus-idna-to-unicode-rhs () - "Decode IDNA strings in RHS in From:, To: and Cc: headers in current buffer." - (when (condition-case nil (require 'idna) (file-error)) - (let ((inhibit-point-motion-hooks t) - buffer-read-only) - (article-narrow-to-head) - (goto-char (point-min)) - (while (re-search-forward "\\(xn--.*\\)[ \t\n\r,>]" nil t) - (let (ace unicode) - (when (save-match-data - (and (setq ace (match-string 1)) - (save-excursion (and (re-search-backward "^[^ \t]" nil t) - (looking-at "From\\|To\\|Cc"))) - (save-excursion (backward-char) - (message-idna-inside-rhs-p)) - (setq unicode (idna-to-unicode ace)))) - (unless (string= ace unicode) - (replace-match unicode nil nil nil 1)))))))) - -(provide 'gnus-idna) - -;; gnus-idna.el ends here