cgit.sxemacs.org Git - packages/blob - xemacs-packages/net-utils/idna.el

   1 ;;; idna.el --- Internationalizing Domain Names in Applications. -*- coding: iso-8859-1 -*-
   2
   3 ;; Copyright (C) 2003-2013 Simon Josefsson
   4 ;; Keywords: idna, idn, domain name, internationalization
   5
   6 ;; This file is part of GNU Libidn.
   7
   8 ;; This program is free software: you can redistribute it and/or modify
   9 ;; it under the terms of the GNU General Public License as published by
  10 ;; the Free Software Foundation, either version 3 of the License, or
  11 ;; (at your option) any later version.
  12
  13 ;; This program is distributed in the hope that it will be useful,
  14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16 ;; GNU General Public License for more details.
  17
  18 ;; You should have received a copy of the GNU General Public License
  19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  20
  21 ;;; Commentary:
  22
  23 ;; A simple wrapper around the command line "idn" utility in GNU
  24 ;; Libidn to make IDNA ToASCII and ToUnicode operations available in
  25 ;; Emacs.
  26
  27 ;; Example:
  28 ;;
  29 ;; (idna-to-ascii "räksmörgås.gnu.org")
  30 ;; => "xn--rksmrgs-5wao1o.gnu.org"
  31 ;;
  32 ;; (idna-to-ascii "www.gnu.org")
  33 ;; => "www.gnu.org"
  34 ;;
  35 ;; (idna-to-unicode "xn--rksmrgs-5wao1o.gnu.org")
  36 ;; => "räksmörgås.gnu.org"
  37 ;;
  38 ;; (idna-to-unicode "www.gnu.org")
  39 ;; => "www.gnu.org"
  40
  41 ;; Todo: Support AllowUnassigned and UseSTD3ASCIIRules somehow?
  42
  43 ;; This package is useless unless your emacs has at least partial
  44 ;; support for the UTF-8 coding system.
  45
  46 ;; Report bugs to bug-libidn@gnu.org.
  47
  48 ;;; Code:
  49
  50 (eval-when (load eval)
  51   (unless (find-coding-system 'utf-8)
  52     (error 'invalid-operation "`idna.el' requires support for the utf-8 coding system")))
  53
  54 (defgroup idna nil
  55   "Internationalizing Domain Names in Applications.")
  56
  57 (defcustom idna-program "idn"
  58   "Name of the GNU Libidn \"idn\" application."
  59   :type 'string
  60   :group 'idna)
  61
  62 (defcustom idna-environment '("CHARSET=UTF-8")
  63   "List of environment variable definitions prepended to `process-environment'."
  64   :type '(repeat string)
  65   :group 'idna)
  66
  67 (defcustom idna-to-ascii-parameters '("--quiet"
  68                                       "--idna-to-ascii"
  69                                       "--usestd3asciirules")
  70   "Parameters passed to `idna-program' to invoke IDNA ToASCII mode."
  71   :type '(repeat string)
  72   :group 'idna)
  73
  74 (defcustom idna-to-unicode-parameters '("--quiet"
  75                                         "--idna-to-unicode"
  76                                         "--usestd3asciirules")
  77   "Parameters passed `idna-program' to invoke IDNA ToUnicode mode."
  78   :type '(repeat string)
  79   :group 'idna)
  80
  81 ;; Internal process handling:
  82
  83 (defvar idna-to-ascii-process nil
  84   "Internal variable holding process for ToASCII.")
  85 (defvar idna-to-ascii-response nil
  86   "Internal variable holding response data received from ToASCII process.")
  87
  88 (defun idna-to-ascii-response-clear ()
  89   (setq idna-to-ascii-response nil))
  90
  91 (defun idna-to-ascii-response ()
  92   (while (and (eq (process-status idna-to-ascii-process) 'run)
  93               (null idna-to-ascii-response))
  94     (accept-process-output idna-to-ascii-process 1))
  95   idna-to-ascii-response)
  96
  97 (defun idna-to-ascii-filter (process string)
  98   (setq idna-to-ascii-response (concat idna-to-ascii-response string)))
  99
 100 (defun idna-to-ascii-process ()
 101   (if (and idna-to-ascii-process
 102            (eq (process-status idna-to-ascii-process) 'run))
 103       idna-to-ascii-process
 104     (if idna-to-ascii-process
 105         (condition-case ()
 106             (kill-process idna-to-ascii-process)
 107           (error)))
 108     (when (setq idna-to-ascii-process
 109                 (let ((process-environment (append idna-environment
 110                                                    process-environment)))
 111                   (apply 'start-process "idna" nil idna-program
 112                          idna-to-ascii-parameters)))
 113       (set-process-filter idna-to-ascii-process 'idna-to-ascii-filter)
 114       (set-process-coding-system idna-to-ascii-process 'utf-8 'utf-8)
 115       (process-kill-without-query idna-to-ascii-process))
 116     idna-to-ascii-process))
 117
 118 (defvar idna-to-unicode-process nil
 119   "Internal variable holding process for ToASCII.")
 120 (defvar idna-to-unicode-response nil
 121   "Internal variable holding response data received from ToASCII process.")
 122
 123 (defun idna-to-unicode-response-clear ()
 124   (setq idna-to-unicode-response nil))
 125
 126 (defun idna-to-unicode-response ()
 127   (while (and (eq (process-status idna-to-unicode-process) 'run)
 128               (null idna-to-unicode-response))
 129     (accept-process-output idna-to-unicode-process 1))
 130   idna-to-unicode-response)
 131
 132 (defun idna-to-unicode-filter (process string)
 133   (setq idna-to-unicode-response (concat idna-to-unicode-response string)))
 134
 135 (defun idna-to-unicode-process ()
 136   (if (and idna-to-unicode-process
 137            (eq (process-status idna-to-unicode-process) 'run))
 138       idna-to-unicode-process
 139     (if idna-to-unicode-process
 140         (condition-case ()
 141             (kill-process idna-to-unicode-process)
 142           (error)))
 143     (when (setq idna-to-unicode-process
 144                 (let ((process-environment (append idna-environment
 145                                                    process-environment)))
 146                   (apply 'start-process "idna" nil idna-program
 147                          idna-to-unicode-parameters)))
 148       (set-process-filter idna-to-unicode-process 'idna-to-unicode-filter)
 149       (set-process-coding-system idna-to-unicode-process 'utf-8 'utf-8)
 150       (process-kill-without-query idna-to-unicode-process))
 151     idna-to-unicode-process))
 152
 153 ;; IDNA Elisp API:
 154
 155 (defun idna-to-ascii (str)
 156   "Returns an ASCII Compatible Encoding (ACE) of STR.
 157 It is computed by the IDNA ToASCII operation, after converting the
 158 input to UTF-8."
 159   (let ((proc (idna-to-ascii-process))
 160         string)
 161     (if (null proc)
 162         (error "Cannot start idn application (to-ascii)")
 163       (idna-to-ascii-response-clear)
 164       (process-send-string proc (concat str "\n"))
 165       (setq string (idna-to-ascii-response))
 166       (if (and string (string= (substring string (1- (length string))) "\n"))
 167           (substring string 0 (1- (length string)))
 168         string))))
 169
 170 (defun idna-to-unicode (str)
 171   "Returns a possibly multibyte string after decoding STR.
 172 It is computed by the IDNA ToUnicode operation."
 173   (let ((proc (idna-to-unicode-process))
 174         string)
 175     (if (null proc)
 176         (error "Cannot start idn application (to-unicode)")
 177       (idna-to-unicode-response-clear)
 178       (process-send-string proc (concat str "\n"))
 179       (setq string (idna-to-unicode-response))
 180       (if (and string (string= (substring string (1- (length string))) "\n"))
 181           (substring string 0 (1- (length string)))
 182         string))))
 183
 184 (defun idna-shutdown ()
 185   "Kill the IDNA related processes."
 186   (interactive)
 187   (if (and idna-to-ascii-process
 188            (eq (process-status idna-to-ascii-process) 'run))
 189       (kill-process idna-to-ascii-process))
 190   (if (and idna-to-unicode-process
 191            (eq (process-status idna-to-unicode-process) 'run))
 192       (kill-process idna-to-unicode-process)))
 193
 194 (provide 'idna)
 195
 196 ;;; idna.el ends here