wok-current diff emacs-pkg-text-translator/stuff/text-translator.el @ rev 13490

up subversion (1.7.7)
author Samuel Trassare <samuel_trassare@yahoo.com>
date Thu Oct 11 23:41:47 2012 +0000 (2012-10-11)
parents
children
line diff
     1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/emacs-pkg-text-translator/stuff/text-translator.el	Thu Oct 11 23:41:47 2012 +0000
     1.3 @@ -0,0 +1,555 @@
     1.4 +;;; text-translator.el --- Text Translator
     1.5 +
     1.6 +;; Copyright (C) 2007-2010  khiker
     1.7 +
     1.8 +;; Author: khiker <khiker.mail+elisp@gmail.com>
     1.9 +;;         plus   <MLB33828@nifty.com>
    1.10 +
    1.11 +;; This file is free software; you can redistribute it and/or modify
    1.12 +;; it under the terms of the GNU General Public License as published by
    1.13 +;; the Free Software Foundation; either version 2, or (at your option)
    1.14 +;; any later version.
    1.15 +
    1.16 +;; This file is distributed in the hope that it will be useful,
    1.17 +;; but WITHOUT ANY WARRANTY; without even the implied warranty of
    1.18 +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    1.19 +;; GNU General Public License for more details.
    1.20 +
    1.21 +;; You should have received a copy of the GNU General Public License
    1.22 +;; along with GNU Emacs; see the file COPYING.  If not, write to
    1.23 +;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
    1.24 +;; Boston, MA 02110-1301, USA.
    1.25 +
    1.26 +;;; Commentary:
    1.27 +
    1.28 +;; Translates character strings on Emacs.
    1.29 +;; This package use the text translation service that exists on the internet.
    1.30 +
    1.31 +;; Read README.en (English) or README.ja (Japanese).
    1.32 +
    1.33 +;;; Code:
    1.34 +
    1.35 +(require 'text-translator-vars)
    1.36 +
    1.37 +(defun text-translator (arg &optional last engine-or-func)
    1.38 +  "The function which does text translation.
    1.39 +Use Excite, Google and so translation site.
    1.40 +1. Mark is active
    1.41 + - Prefix was supplied.
    1.42 +   1. Choose translation site which you use.
    1.43 +   2. Translate by type which you selected.
    1.44 + - Prefix was not supplied.
    1.45 +   Translate range of region that you selected by
    1.46 +   first element of `text-translator-engine-history'.
    1.47 +   (If `text-translator-engine-history' is nil,
    1.48 +    use `text-translator-default-engine'.)
    1.49 +2. Mark is deactive
    1.50 + - Prefix was supplied.
    1.51 +   1. Choose translation site which you use.
    1.52 +   2. Translate value which you input from minibuffer by type you selected.
    1.53 + - Prefix was not supplied.
    1.54 +   Translate value which you input from minibuffer by
    1.55 +   first element of `text-translator-engine-history'.
    1.56 +   (If `text-translator-engine-history' is nil,
    1.57 +    use `text-translator-default-engine'.)"
    1.58 +  (interactive "P")
    1.59 +  (add-to-list 'text-translator-engine-history text-translator-default-engine)
    1.60 +  (let ((minibuffer-history text-translator-engine-history)
    1.61 +        (engine (text-translator-check-valid-translation-engine
    1.62 +                 engine-or-func (car text-translator-engine-history)))
    1.63 +        str)
    1.64 +    ;; If prefix-arg is non-nil, change translation type.
    1.65 +    (when (or arg last)
    1.66 +      (setq engine (completing-read
    1.67 +                    (format "Select translation engine (default %s): " engine)
    1.68 +                    text-translator-site-data-alist nil t nil nil engine)))
    1.69 +    (setq str
    1.70 +          (cond
    1.71 +           (last
    1.72 +            text-translator-last-string)
    1.73 +           (t
    1.74 +            (text-translator-region-or-read-string
    1.75 +             (format "Enter string translated by %s: " engine)))))
    1.76 +    (text-translator-client
    1.77 +     (text-translator-check-valid-translation-engine
    1.78 +      (and (functionp engine-or-func) (funcall engine-or-func engine str))
    1.79 +      engine)
    1.80 +     str)))
    1.81 +
    1.82 +(defun text-translator-translate-by-auto-selection (arg)
    1.83 +  "Function that translates by auto selection of translation engine.
    1.84 +Function that select automatically is value of `text-translator-auto-selection-func'."
    1.85 +  (interactive "P")
    1.86 +  (text-translator arg nil text-translator-auto-selection-func))
    1.87 +
    1.88 +(defun text-translator-translate-by-auto-selection-enja (engine str)
    1.89 +  "Automatic selection function for English to Japanese(or Japanese to English)
    1.90 +translation.
    1.91 +If alphabet ratio is over 40%, select engine which is translating from English to Japanese.
    1.92 +Otherwise, from Japanese to English."
    1.93 +  (setq str (or str ""))
    1.94 +  (format
    1.95 +   "%s_%s"
    1.96 +   (text-translator-get-engine-type-or-site engine t)
    1.97 +   (if (> (/ (* (length (replace-regexp-in-string "[^A-Za-z]+" "" str)) 100)
    1.98 +             (length str))
    1.99 +          40)
   1.100 +       "enja" "jaen")))
   1.101 +
   1.102 +(defun text-translator-translate-last-string ()
   1.103 +  "The function to translate in the translation site that
   1.104 +I choose with the character string that I translated in the last time."
   1.105 +  (interactive)
   1.106 +  (text-translator nil t))
   1.107 +
   1.108 +
   1.109 +(defun text-translator-region-or-read-string (&optional prompt)
   1.110 +  "If mark is active, return the region, otherwise, read string with PROMPT."
   1.111 +  (cond
   1.112 +   (mark-active
   1.113 +    (buffer-substring-no-properties (region-beginning) (region-end)))
   1.114 +   (t
   1.115 +    (read-string (or prompt "Enter string: ")))))
   1.116 +
   1.117 +(defun text-translator-all (arg &optional key str)
   1.118 +  "The function to translate in all of translate sites that matches
   1.119 +the selected type."
   1.120 +  (interactive "P")
   1.121 +  (let ((hash text-translator-sitedata-hash)
   1.122 +        keys)
   1.123 +    (setq str (or str (text-translator-region-or-read-string)))
   1.124 +    (when (or (null hash)
   1.125 +              arg)
   1.126 +      (setq text-translator-sitedata-hash
   1.127 +            (text-translator-update-hashtable))
   1.128 +      (setq hash text-translator-sitedata-hash))
   1.129 +    (maphash '(lambda (x y)
   1.130 +                (setq keys (cons x keys)))
   1.131 +             hash)
   1.132 +    (setq key (or key (completing-read "Select type: " keys nil t)))
   1.133 +    (when key
   1.134 +      (save-selected-window
   1.135 +        (pop-to-buffer text-translator-buffer)
   1.136 +        (setq buffer-read-only nil)
   1.137 +        (erase-buffer)
   1.138 +        (text-translator-mode))
   1.139 +      (let ((sites (gethash key hash)))
   1.140 +        (setq text-translator-last-string str)
   1.141 +        (setq text-translator-search-regexp-or-func
   1.142 +              (concat "_" key))
   1.143 +        (dolist  (i sites)
   1.144 +          (text-translator-client i str t))))))
   1.145 +
   1.146 +(defun text-translator-all-by-auto-selection (arg)
   1.147 +  "The function to translate in all of translate sites, whose translation engine is selected automatically.
   1.148 +The selection function is the value of `text-translator-auto-selection-func'."
   1.149 +  (interactive "P")
   1.150 +  (let ((str (text-translator-region-or-read-string)))
   1.151 +    (text-translator-all
   1.152 +     arg
   1.153 +     (substring (funcall text-translator-auto-selection-func "" str) 1)
   1.154 +     str)))
   1.155 +
   1.156 +(defun text-translator-client (engine str &optional all)
   1.157 +  "Function that throws out words and phrases that want to translate into
   1.158 +specified site, and receives translation result."
   1.159 +  (let* ((history-delete-duplicates t)
   1.160 +         (buf (cond (all
   1.161 +                     (concat text-translator-work-buffer
   1.162 +                             (replace-regexp-in-string "_.*"
   1.163 +                                                       ""
   1.164 +                                                       engine)))
   1.165 +                    (t
   1.166 +                     text-translator-work-buffer)))
   1.167 +         (alist
   1.168 +          (cond
   1.169 +           ((not text-translator-do-fill-region)
   1.170 +            text-translator-pre-string-replace-alist)
   1.171 +           ;; for example, if engine is "excite.co.jp_enja",
   1.172 +           ;; this code returns "en".
   1.173 +           ((member (substring
   1.174 +                     (text-translator-get-engine-type-or-site engine) 0 2)
   1.175 +                    text-translator-space-division-languages)
   1.176 +            ;; replace "\n" to " ".
   1.177 +            (append '(("\n" . " ") ("\r" . ""))
   1.178 +                    text-translator-pre-string-replace-alist))
   1.179 +           (t
   1.180 +            ;; replace "\n" to "".
   1.181 +            (append '(("\n" . "") ("\r" . ""))
   1.182 +                    text-translator-pre-string-replace-alist))))
   1.183 +         (str (text-translator-replace-string str alist))
   1.184 +         (type (assoc engine text-translator-site-data-alist))
   1.185 +         (proc (open-network-stream "Web Connection" buf
   1.186 +                                    (or text-translator-proxy-server
   1.187 +                                        (nth 1 type))
   1.188 +                                    (or (and text-translator-proxy-server
   1.189 +                                             text-translator-proxy-port)
   1.190 +                                        80)))
   1.191 +         ;;(process-connection-type nil)
   1.192 +         (enc-str (text-translator-url-encode-string str (nth 4 type)))
   1.193 +         (post-str (if (nth 3 type) (format (nth 3 type) enc-str) nil))
   1.194 +         (truncate-partial-width-windows nil))
   1.195 +    (unless all
   1.196 +      (add-to-history 'text-translator-engine-history engine)
   1.197 +      (setq text-translator-search-regexp-or-func (nth 5 type))
   1.198 +      (setq text-translator-last-string str))
   1.199 +    (with-current-buffer (get-buffer-create buf)
   1.200 +      (erase-buffer)
   1.201 +      (set-process-coding-system proc (nth 4 type) 'binary)
   1.202 +      (set-process-filter proc 'text-translator-client-filter)
   1.203 +      (process-send-string
   1.204 +       proc
   1.205 +       (concat
   1.206 +        (cond
   1.207 +         (post-str
   1.208 +          ;; use POST method
   1.209 +          (concat "POST " (nth 2 type) "\r\n"))
   1.210 +         (t
   1.211 +          ;; use GET method
   1.212 +          (concat "GET " (format (nth 2 type) enc-str) "\r\n")))
   1.213 +        (and text-translator-proxy-server
   1.214 +             text-translator-proxy-user
   1.215 +             text-translator-proxy-password
   1.216 +             (format "Proxy-Authorization: Basic %s \r\n"
   1.217 +                     (base64-encode-string
   1.218 +                      (concat text-translator-proxy-user ":"
   1.219 +                              text-translator-proxy-password))))
   1.220 +        "HOST: " (nth 1 type) "\r\n"
   1.221 +        "User-Agent: " text-translator-user-agent "\r\n"
   1.222 +;;        "Accept: text/xml,application/xml,application/xhtml+xml,text/html;q=0.9,text/plain;q=0.8,image/png,*/*;q=0.5" "\r\n"
   1.223 +;;        "Accept-Language: ja,en-us;q=0.7,en;q=0.3" "\r\n"
   1.224 +        "Accept-Encoding: identity\r\n"
   1.225 +        "Accept-Charset: Shift_JIS,utf-8;q=0.7,*;q=0.7\r\n"
   1.226 +        "Keep-Alive: 300" "\r\n"
   1.227 +        "Connection: keep-alive" "\r\n"
   1.228 +        (when post-str
   1.229 +          (concat
   1.230 +           "Content-Type: application/x-www-form-urlencoded\r\n"
   1.231 +           "Content-Length: "
   1.232 +           (number-to-string (string-bytes post-str)) "\r\n"
   1.233 +           "\r\n"
   1.234 +           post-str "\r\n"))
   1.235 +        "\r\n"))
   1.236 +      (message "Translating...")
   1.237 +      (unless (or all
   1.238 +                  text-translator-display-popup)
   1.239 +        (save-selected-window
   1.240 +          (pop-to-buffer text-translator-buffer)
   1.241 +          (setq buffer-read-only nil)
   1.242 +          (erase-buffer)
   1.243 +          (text-translator-mode)
   1.244 +          (setq mode-line-buffer-identification
   1.245 +                `("%b [" ,(car text-translator-engine-history) "]")))))))
   1.246 +
   1.247 +(defun text-translator-client-filter (proc str)
   1.248 +  (let ((regex-or-func text-translator-search-regexp-or-func)
   1.249 +        bname all-flag)
   1.250 +    (with-current-buffer (process-buffer proc)
   1.251 +      (goto-char (process-mark proc))
   1.252 +      (insert (format "%s" str))
   1.253 +      (set-marker (process-mark proc) (point))
   1.254 +      (setq bname (buffer-name))
   1.255 +      (setq all-flag (not (string= bname text-translator-work-buffer)))
   1.256 +      (when all-flag
   1.257 +        (setq regex-or-func
   1.258 +              (nth 5
   1.259 +                   (assoc (concat
   1.260 +                           (substring bname
   1.261 +                                      (length text-translator-work-buffer)
   1.262 +                                      (length bname))
   1.263 +                           regex-or-func)
   1.264 +                          text-translator-site-data-alist))))
   1.265 +      (setq str (text-translator-replace-string
   1.266 +                 (or (cond
   1.267 +                      ((functionp regex-or-func)
   1.268 +                       (funcall regex-or-func))
   1.269 +                      ((re-search-backward regex-or-func nil t)
   1.270 +                       (match-string 1)))
   1.271 +                     "")
   1.272 +                 text-translator-post-string-replace-alist))
   1.273 +      (unless (string= "" str)
   1.274 +        (delete-process proc)
   1.275 +        (setq bname (buffer-name))
   1.276 +        (setq all-flag (not (string= bname text-translator-work-buffer)))
   1.277 +        (when (or all-flag
   1.278 +                  (not text-translator-display-popup))
   1.279 +          (text-translator-display-window str bname all-flag))))
   1.280 +    ;; To display in popup-tip, buffer is out of with-current-buffer.
   1.281 +    (when (and (not (string= "" str))
   1.282 +               (not all-flag)
   1.283 +               (fboundp 'popup-tip)
   1.284 +               (eq text-translator-display-popup t))
   1.285 +      (text-translator-display-popup str))))
   1.286 +
   1.287 +(defun text-translator-display-window (str buf all-flag)
   1.288 +  (let ((window (get-buffer-window text-translator-buffer))
   1.289 +        (window-min-height
   1.290 +         (if (> text-translator-window-min-height (/ (frame-height) 2))
   1.291 +             (/ (frame-height) 2)
   1.292 +           (1+ text-translator-window-min-height))))
   1.293 +    (set-buffer text-translator-buffer)
   1.294 +    (setq buffer-read-only nil)
   1.295 +    (cond
   1.296 +     (all-flag
   1.297 +      (insert (concat
   1.298 +               (propertize
   1.299 +                (format "-----  %s  -----\n"
   1.300 +                        (substring buf
   1.301 +                                   (length text-translator-work-buffer)
   1.302 +                                   (length buf)))
   1.303 +                'face font-lock-keyword-face)
   1.304 +               str "\n\n")))
   1.305 +     (t (when text-translator-leave-string
   1.306 +          (insert
   1.307 +           (concat
   1.308 +            (propertize "-----   Original  -----\n"
   1.309 +                        'face font-lock-keyword-face)
   1.310 +            text-translator-last-string
   1.311 +            "\n\n"
   1.312 +            (propertize "***** Translation *****\n"
   1.313 +                        'face font-lock-keyword-face))))
   1.314 +        (insert (concat str "\n"))
   1.315 +        (when text-translator-do-fill-region
   1.316 +          (goto-char (- (point) (/ (length str) 2)))
   1.317 +          (call-interactively 'fill-paragraph))
   1.318 +        (set-buffer-modified-p nil)
   1.319 +        ;; adjust window height
   1.320 +        (when (and text-translator-auto-window-adjust
   1.321 +                   (window-live-p window))
   1.322 +          (balance-windows)
   1.323 +          (shrink-window-if-larger-than-buffer window))
   1.324 +        (message "") ; prevent minibuffer from becoming two line.
   1.325 +        (ding)
   1.326 +        (message "Translating...done")))))
   1.327 +
   1.328 +(defun text-translator-display-popup (str)
   1.329 +  (let ((read-only-p buffer-read-only))
   1.330 +    (setq str (with-temp-buffer
   1.331 +                (insert str)
   1.332 +                (when text-translator-do-fill-region
   1.333 +                  (goto-char (- (point) (/ (length str) 2)))
   1.334 +                  (call-interactively 'fill-paragraph))
   1.335 +                (buffer-string)))
   1.336 +    (ding)
   1.337 +    (message "Translating...done")
   1.338 +    (if read-only-p
   1.339 +        ;; temporay cancel buffer-read-only
   1.340 +        (unwind-protect (progn
   1.341 +                          (setq buffer-read-only nil)
   1.342 +                          (popup-tip str :margin t))
   1.343 +          (setq buffer-read-only t))
   1.344 +      (popup-tip str :margin t))))
   1.345 +
   1.346 +(defun text-translator-update-hashtable ()
   1.347 +  (let ((hash (make-hash-table :test 'equal)))
   1.348 +    (mapc '(lambda (x)
   1.349 +             (let ((matched (replace-regexp-in-string "\\([^_]*\\)_"
   1.350 +                                                      ""
   1.351 +                                                      (car x))))
   1.352 +               (unless (or (string= (car x) matched)
   1.353 +                           (eq ?* (aref matched 0)))
   1.354 +                 (cond
   1.355 +                  ((gethash matched hash)
   1.356 +                   (puthash matched
   1.357 +                            (cons (car x) (gethash matched hash))
   1.358 +                            hash))
   1.359 +                  (t
   1.360 +                   (puthash matched (list (car x)) hash))))))
   1.361 +          text-translator-site-data-alist)
   1.362 +    hash))
   1.363 +
   1.364 +(defun text-translator-replace-string (str replace)
   1.365 +  "Function that converts character string specified for argument STR
   1.366 +according to rule REPLACE."
   1.367 +  (with-temp-buffer
   1.368 +    (insert str)
   1.369 +    ;; convert unusable string
   1.370 +    (format-replace-strings replace)
   1.371 +    (buffer-string)))
   1.372 +
   1.373 +(defun text-translator-extract-tag-exclusion-string (regex &optional dont-convert-br)
   1.374 +;;  (when (re-search-backward regex nil t)
   1.375 +  (when (re-search-backward regex nil t)
   1.376 +    ;; first: convert <br> tag to '\n' (when variable dont-convert-br is nil)
   1.377 +    ;; second: convert any another tags to empty string.
   1.378 +    (let ((matchstr (match-string 1)))
   1.379 +      (setq matchstr
   1.380 +            (text-translator-replace-string
   1.381 +             matchstr
   1.382 +             text-translator-post-string-replace-alist))
   1.383 +      (replace-regexp-in-string
   1.384 +       "<.*?>" "" (if dont-convert-br
   1.385 +                      matchstr
   1.386 +                    (replace-regexp-in-string
   1.387 +                     "<[bB][rR]\\( /\\)?>" "\n" matchstr))))))
   1.388 +
   1.389 +;;;; major-mode text-translator-mode
   1.390 +
   1.391 +;; variables for major mode
   1.392 +(defvar text-translator-mode nil)
   1.393 +(defvar text-translator-mode-map nil)
   1.394 +(defvar text-translator-mode-pkey-map nil)
   1.395 +(defvar text-translator-mode-syntax-table nil)
   1.396 +(defvar text-translator-mode-abbrev-table nil)
   1.397 +(define-abbrev-table 'text-translator-mode-abbrev-table ())
   1.398 +
   1.399 +;; keymap definition
   1.400 +(unless text-translator-mode-map
   1.401 +  (setq text-translator-mode-map (make-sparse-keymap))
   1.402 +  (define-prefix-command 'text-translator-mode-pkey-map)
   1.403 +  (let ((map text-translator-mode-pkey-map))
   1.404 +    (define-key map "\C-q" 'text-translator-quit)
   1.405 +    (define-key map "\C-a" 'text-translator-translate-recent-type)
   1.406 +    (define-key map "\C-l" 'text-translator-display-last-string)
   1.407 +    (define-key map "\C-d" 'text-translator-translate-default)
   1.408 +    (define-key map "\C-s" 'text-translator-toggle-leave-string)))
   1.409 +
   1.410 +;; major-mode
   1.411 +(defun text-translator-mode ()
   1.412 +  "Major mode for text-translator."
   1.413 +  (kill-all-local-variables)
   1.414 +  (setq local-abbrev-table text-translator-mode-abbrev-table)
   1.415 +  (set-syntax-table text-translator-mode-syntax-table)
   1.416 +  (setq mode-name text-translator-mode-name)
   1.417 +  (setq major-mode 'text-translator-mode)
   1.418 +  (define-key text-translator-mode-map
   1.419 +    text-translator-prefix-key text-translator-mode-pkey-map)
   1.420 +  (use-local-map text-translator-mode-map)
   1.421 +  (run-hooks 'text-translator-mode-hook))
   1.422 +
   1.423 +;; syntax-table
   1.424 +(unless text-translator-mode-syntax-table
   1.425 +  (setq text-translator-mode-syntax-table (make-syntax-table)))
   1.426 +
   1.427 +;; functions for major-mode
   1.428 +(defun text-translator-quit ()
   1.429 +  "Function that closes buffer for text-translator.
   1.430 +If window only have *translated* buffer, change another buffer."
   1.431 +  (interactive)
   1.432 +  (bury-buffer)
   1.433 +  (unless (one-window-p)
   1.434 +    (delete-window)))
   1.435 +
   1.436 +(defun text-translator-toggle-leave-string ()
   1.437 +  "Function that change value of `text-translator-leave-string'.
   1.438 +Toggle to display a translation result buffer of character
   1.439 +string that used last time."
   1.440 +  (interactive)
   1.441 +  (setq text-translator-leave-string (not text-translator-leave-string))
   1.442 +  (message "Pretranslational string switched %s to leave."
   1.443 +           (if text-translator-leave-string "" " not")))
   1.444 +
   1.445 +(defun text-translator-display-last-string (arg)
   1.446 +  "Function that displays translated character string last time.
   1.447 +Default display to minibuffer.
   1.448 +With prefix-arg, insert buffer."
   1.449 +  (interactive "P")
   1.450 +  (if arg
   1.451 +      (insert text-translator-last-string)
   1.452 +    (message "%s" text-translator-last-string)))
   1.453 +
   1.454 +(defun text-translator-translate-recent-type ()
   1.455 +  "Function that translates by type corresponding to the language
   1.456 +that used last time.
   1.457 +For example, last time, if you have used excite.co.jp_enja,
   1.458 +this time select from **_enja, and, translates."
   1.459 +  (interactive)
   1.460 +  (let* ((minibuffer-history text-translator-engine-history)
   1.461 +         (engine (car text-translator-engine-history))
   1.462 +         (last-type
   1.463 +          (concat "_" (text-translator-get-engine-type-or-site engine)))
   1.464 +         (type (completing-read
   1.465 +                (format "Select translation engine (last %s): " engine)
   1.466 +                (delq nil
   1.467 +                      (mapcar
   1.468 +                       (lambda (x)
   1.469 +                         (when (string-match last-type (car x))
   1.470 +                           x))
   1.471 +                       text-translator-site-data-alist))
   1.472 +                nil t)))
   1.473 +    (unless (string= "" type)
   1.474 +      (text-translator-client type text-translator-last-string))))
   1.475 +
   1.476 +(defun text-translator-translate-default ()
   1.477 +  "Function that translates by default type only.
   1.478 +Default is value of `text-translator-default-engine'."
   1.479 +  (interactive)
   1.480 +  (text-translator nil nil text-translator-default-engine))
   1.481 +
   1.482 +(defun text-translator-check-valid-translation-engine (engine valid-engine)
   1.483 +  "Check ENGINE that is registered in `text-translator-site-data-alist'.
   1.484 +Return ENGINE if it is already registered, otherwise return VALID-ENGINE."
   1.485 +  (or (car (member engine (mapcar 'car text-translator-site-data-alist)))
   1.486 +      valid-engine))
   1.487 +
   1.488 +(defun text-translator-get-engine-type-or-site (engine &optional get-site)
   1.489 +  "Get a translation engine type or site name.
   1.490 +If optional argument GET-SITE is nil, return a translation engine type.
   1.491 +Otherwise return a translation site name."
   1.492 +  (nth (if get-site 0 1) (split-string engine "_")))
   1.493 +
   1.494 +;; by google2.el
   1.495 +(defun text-translator-url-encode-string (str &optional coding)
   1.496 +  (apply (function concat)
   1.497 +         (mapcar
   1.498 +          (lambda (ch)
   1.499 +            (cond
   1.500 +             ((eq ch ?\n)               ; newline
   1.501 +              "%0D%0A")
   1.502 +             ((string-match "[-a-zA-Z0-9_:/]" (char-to-string ch)) ; xxx?
   1.503 +              (char-to-string ch))      ; printable
   1.504 +             ((char-equal ch ?\x20)     ; space
   1.505 +              "+")
   1.506 +             (t
   1.507 +              (format "%%%02X" ch))))   ; escape
   1.508 +          ;; Coerce a string to a list of chars.
   1.509 +          (append (encode-coding-string (or str "") (or coding 'iso-2022-jp))
   1.510 +                  nil))))
   1.511 +
   1.512 +;; initialization function
   1.513 +(defun text-translator-site-data-init ()
   1.514 +  ;; initialize
   1.515 +  (setq text-translator-site-data-alist nil)
   1.516 +  (setq text-translator-site-data-alist
   1.517 +        text-translator-site-data-minimum-alist)
   1.518 +  (dolist (site text-translator-site-data-template-alist)
   1.519 +    (let ((tt-convert-name '(lambda (lang)
   1.520 +                            (let ((match-lang (assoc lang
   1.521 +                                                     (nth 7 site))))
   1.522 +                              (if match-lang
   1.523 +                                  (cdr match-lang)
   1.524 +                                lang))))
   1.525 +        (tt-replace-string '(lambda (pstr olang tlang)
   1.526 +                              (when olang
   1.527 +                                (setq pstr
   1.528 +                                    (replace-regexp-in-string "%o"
   1.529 +                                                              olang
   1.530 +                                                              pstr)))
   1.531 +                              (when tlang
   1.532 +                                (setq pstr
   1.533 +                                    (replace-regexp-in-string "%t"
   1.534 +                                                              tlang
   1.535 +                                                              pstr))
   1.536 +                                pstr)))
   1.537 +        tt-alist)
   1.538 +    (dolist (i (nth 6 site))
   1.539 +      (add-to-list 'text-translator-site-data-alist
   1.540 +                   (list (format "%s"
   1.541 +                                 (concat (nth 0 site)
   1.542 +                                         "_"
   1.543 +                                         (funcall tt-convert-name (car i))
   1.544 +                                         (funcall tt-convert-name (cdr i))))
   1.545 +                         (nth 1 site)
   1.546 +                         (nth 2 site)
   1.547 +                         (funcall tt-replace-string
   1.548 +                                  (nth 3 site) (car i) (cdr i))
   1.549 +                         (nth 4 site)
   1.550 +                         (nth 5 site)))))))
   1.551 +(text-translator-site-data-init)        ; init
   1.552 +
   1.553 +(provide 'text-translator)
   1.554 +;;; text-translator.el ends here
   1.555 +
   1.556 +;; Local Variables:
   1.557 +;; Coding: utf-8
   1.558 +;; End: