Emacs でテキスト翻訳

(追記)
plus さんからメールをもらいました.
まだ確認してませんが, 色々とまずそうです.
少くとも, physical-line を入れてないと動かないことが判明しています.
修正版を調べて up できるようにします.
(さらに追記)
とりあえず, plus さんに頂いたパッチを適用したバージョンを置いておきます:
text-translator.el.txt
自分でもさらに改良を加えてみる予定です.
(さらに追記(一応))
ブクマしてくれている方も居るので, いまさらですが, 一応.
text-translator のエントリは, 以下のエントリにしました.

• http://d.hatena.ne.jp/khiker/20070503/emacs_text_translator

今後更新があった場合に更新するのも上記エントリで, それ専用に新たにエントリは作りません.

とりあえず, できた.
plus さんからのメールでのアドバイスがきっかけとなり, 前回微妙だった部分は, 大分マシになったと思う.
まだまだバグあると思われるけど, とりあえず公開. いや, 一応それなりに簡単な動作テストはしたよ. もちろん.
excite, google, altavista を利用して, 日本語→英語, 英語→日本語の翻訳ができる.
前回のものからの大きな更新点は,
まず, 名前を text-translate から text-translator に変更したこと.
Ruby のスクリプトを完全に排除して, elisp オンリーにしたこと.
翻訳するために利用できるサイトに altavista を追加したことの3つ.
細かいのもちょいちょいある.

使用するには, 下記コードを text-translator.el のようなファイルに保存して, ロードパスの通た所に置く.
そして, .emacs に以下のような一文を追加する.

(require 'text-translator)
(global-set-key "\C-xt" 'text-translator)

キー割り当ては, お好みで.
リージョンに選択した範囲を翻訳します. デフォルトで使用する翻訳サイトは, excite の英語→日本語です.
他のサイトを使用したければ, C-u, でもつけて関数を実行してください.
リージョンを選択しておかないと, 翻訳する文字列の入力を促されます.

以下コード.
(追記)ファイル置き場にファイルを置きときました → text-translator.el.txt.
拡張子 .txt を削除してロードパスの通った所へ置きてください.

;;; -*- Coding: iso-2022-7bit -*-
;;; text-translator.el --- Text Translator

;; Copyright (C) 2007  khiker

;; Author: khiker <[email protected]>

;; This file 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.

;; This file 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.

;;; Commentary:

;; ウェブ上に存在するテキスト翻訳を行ってくれるサイトを利用して,
;; Emacs 上で文字列の翻訳を行う elisp です.
;;
;; M-x text-translator
;;    翻訳を行う関数.
;;    リージョンの選択が行われていると, その範囲を翻訳します.
;;    リージョンの選択が行われていないと, 翻訳したいテキストの入力を
;;    促します.
;;    接頭辞として, C-u を与えると, 使用する翻訳サイト,
;;    翻訳形式の選択を促す.
;;
;; キーへの関数の割当ての例 :
;; (global-set-key "\C-x\M-t" 'text-translator)
;;
;; [設定できる変数]
;;
;; text-translator-auto-window-adjust
;;     翻訳結果を表示するための分割して出現するバッファの高さを
;;     翻訳結果の行数に従って調節するかどうか.
;;     デフォルトで t. 調節するとなっている.
;;
;; text-translator-leave-string
;;     翻訳したい文字列を翻訳結果のバッファに残すかどうか.
;;     デフォルトで nil. 残さないとなっている.
;;
;; text-translator-pre-string-replace-alist
;;     翻訳サイトに投入する文字列をここに記載されている規則に従い
;;     置き換える.
;;
;; text-translator-post-string-replace-alist
;;     翻訳結果の文字列をここに記載されている規則に従い置き換える.
;;
;; text-translator-site-data-alist
;;     テキスト翻訳に使用するサイトの設定を記述してある連想リスト.
;;     記述されている内容は, これ.
;;     (「翻訳サイトの名前」
;;      「翻訳サイトのホスト」
;;      「POSTから始まる一文」
;;      「POSTで投入するアドレス 翻訳前の文字列を埋め込む所は %s を記述する」
;;      「デコードに使用する文字コード」
;;      「翻訳後の文字列を抜き取るために使用する正規表現」)
;;
;; [コメント]
;;
;; truncate-partial-width-windows は, nil に設定しておいた方が良いかも.
;; バッファを上下に分割して表示するので.
;;
;; [謝辞]
;;
;; この text-translator.el を作成するにあたり,
;; ブログのコメントやメールでアドバイスを頂きました.
;; ありがとうございます.

;;; Code:

(defconst text-translator-buffer "*translated*"
  "翻訳結果を表示するバッファ名.")

(defvar text-translator-auto-window-adjust t
  "分割して表示するウィンドウの高さを調節するかどうか.")

(defvar text-translator-leave-string nil
  "翻訳前の文字列を残すかどうか.")

(defvar text-translator-pre-string-replace-alist
  '(("`" . "‘") ("$" . "＄") ("&" . "＆") (";" . "；")
    ("%" . "％") ("+" . "＋") ("\n" . " ") ("\r" . "")
    ("&#8211;" . "-")  ("&#8226;" . "・") ("“" . "\"") ("”" . "\""))
  "翻訳したい文字列を変換する規則.")

(defvar text-translator-post-string-replace-alist
  '(("。" . "。\n") ("\r" . "") ("&#39;" . "'") ("&quot;" . "\"")
    ("&amp;" . "&") ("&lt;" . "<") ("&gt;" . ">") ("&#8211;" . "-"))
  "翻訳後の文字列を変換する規則.")

(defvar text-translator-site-data-alist
  '(("excite_enja" "www.excite.co.jp" "POST /world/english/ HTTP/1.0"
     "wb_lp=ENJA&before=%s" japanese-shift-jis-unix
     "<input type=\"hidden\" name=\"after\" value=\"\\([^\"]*\\)")

    ("excite_jaen" "www.excite.co.jp" "POST /world/english/ HTTP/1.0"
     "wb_lp=JAEN&before=%s" japanese-shift-jis-unix
     "<input type=\"hidden\" name=\"after\" value=\"\\([^\"]*\\)")

    ("google_enja" "translate.google.com" "POST /translate_t HTTP/1.0"
     "langpair=en|ja&ie=utf-8&oe=utf-8&text=%s" utf-8-dos
     "<div id=result_box dir=ltr>\\([^<]*\\)")

    ("google_jaen" "translate.google.com" "POST /translate_t HTTP/1.0"
     "langpair=ja|en&ie=utf-8&oe=utf-8&text=%s" utf-8-dos
     "<div id=result_box dir=ltr>\\([^<]*\\)")

    ("altavista_enja" "babelfish.altavista.com" "POST /tr HTTP/1.1"
     "doit=done&intl=1&tt=urltext&trtext=%s&lp=en_ja&btnTrTxt=Translate"
     utf-8-dos
     "	    <td bgcolor=white class=s><div style=padding:10px;>\\([^<]*\\)")
;;     "	    <td class=s><input type=hidden name=\"q\" value=\"\\([^\"]*\\)")

    ("altavista_jaen" "babelfish.altavista.com" "POST /tr HTTP/1.1"
     "doit=done&intl=1&tt=urltext&trtext=%s&lp=ja_en&btnTrTxt=Translate"
     utf-8-dos
     "	    <td bgcolor=white class=s><div style=padding:10px;>\\([^<]*\\)"))
  "テキスト翻訳に使用するサイトの設定を記述してある連想リスト.
記述されている内容は, これ.
(「翻訳サイトの名前」
 「翻訳サイトのホスト」
 「POSTから始まる一文」
 「POSTで投入するアドレス 翻訳前の文字列を埋め込む所は %s を記述する」
 「デコードに使用する文字コード」
 「翻訳後の文字列を抜き取るために使用する正規表現」)")

(defun text-translator (arg)
  "Excite 翻訳や Google Translation を使って, テキスト翻訳をする関数.
1. mark が active だった.
 - 前置引数が与えられた :
   1. 使用する翻訳サイトを選択する.
   2. 選択した形式で翻訳する.
 - 前置引数が与えられなかった :
   excite_enja でリージョンに入れた範囲を翻訳する.

2. mark が deactive だった.
 - 前置引数が与えられた.
   1. 使用する翻訳サイトを選択する.
   2. 選択した形式でミニバッファから入力した値を翻訳する.
 - 前置引数が与えられなかった.
   excite_enja でミニバッファから入力した値を翻訳する."
  (interactive "P")
  (let ((def (caar text-translator-site-data-alist)))
    ;; 前置引数があったならば, 使用する翻訳形式を選択したものに変更.
    (when arg
      (setq def (completing-read
                 (format "Select translation type [default:%s] : " def)
                 text-translator-site-data-alist nil t nil nil def)))
    (text-translator-client
     def
     (if mark-active
         (buffer-substring-no-properties (region-beginning) (region-end))
       (read-string (format "translate[%s] : " def))))
    (deactivate-mark)))

(defun text-translator-client (type string)
  "指定したサイトに翻訳したい語句を投げ, 翻訳結果を受け取る関数."
  (let* ((buf text-translator-buffer)
         (string (text-translator-replace-string string 0))
         (type (assoc type text-translator-site-data-alist))
         (proc (open-network-stream "Web Connection" buf (nth 1 type) 80))
         (enc-str (text-translator-url-encode-string string (nth 4 type)))
         (post-str (progn (string-match "%s" (nth 3 type))
                          (replace-match enc-str nil nil (nth 3 type))))
         (truncate-partial-width-windows nil)
         rtn-string)
    (save-current-buffer
      (set-buffer (get-buffer-create buf))
      (erase-buffer)
      (set-process-coding-system proc (nth 4 type) 'binary)
      (process-send-string
       proc
       (format "%s%s%s%s%s%s%s%s%s%s%s%s%s"
               (nth 2 type) "\r\n"
               (concat "HOST: " (nth 1 type)) "\r\n"
               "Accept-Charset: Shift_JIS,utf-8;q=0.7,*;q=0.7\r\n"
               "Content-Type: application/x-www-form-urlencoded\r\n"
               "Content-Length: "
               (string-bytes post-str) "\r\n"
               "\r\n"
               post-str "\r\n"
               "\r\n"))
;;      (message "%s" (format "%s" (process-status "Web Connection")))
      (while (string= (format "%s" (process-status "Web Connection")) "open")
        (sleep-for 0.01))
      ;; 「Process Web Connection connection broken by remote peer」 という
      ;; メッセージを消すためだけに番兵を使用している.
      ;; 本来の使い方がどうも分からない・・・. 上手くいかない・・・.
      (set-process-sentinel proc '(lambda (process status) nil))
;;      (message "%s" (format "%s" (process-status "Web Connection")))
      (re-search-backward (nth 5 type))
      (setq rtn-string (text-translator-replace-string (match-string 1) 1))
      (erase-buffer)
      (when text-translator-leave-string
        (insert (concat string "\n\n")))
      (insert (concat rtn-string "\n"))
      (end-of-buffer)
      (display-buffer buf)
      ;; ウィンドウの大きさを調節する部分
      (when text-translator-auto-window-adjust
        (balance-windows)
        (let ((height (text-translator-count-line)))
          ;; ウィンドウの大きさが全体の半分以上になるならば, 半分に留める
          (when (< height (window-height))
            (shrink-window
             (if (< (text-translator-count-line) 4)
                 (- 4 (window-height))
               (- (text-translator-count-line) (- (window-height) 1))))))))))

(defun text-translator-replace-string (string state)
"引数 `string' に指定された文字列を
規則 `text-translator-pre-string-replace-alist', もしくは,
`text-translator-post-string-replace-alist' に従い変換する関数.
第2引数 `state' は, 0 か 1 の値を取る.
0 ならば, text-translator-pre-string-replace-alist が,
1 ならば, text-translator-post-string-replace-alist が適用される."
  (with-temp-buffer
    (set-buffer (get-buffer-create text-translator-buffer))
    (erase-buffer)
    (insert string)
    ;; 直接使用できない文字を全角に変換する.
    (format-replace-strings (if (= state 0)
                                text-translator-pre-string-replace-alist
                              text-translator-post-string-replace-alist))
    (buffer-substring-no-properties (point-min) (point-max))))

(defun text-translator-count-line ()
  "現在, バッファに表示されている, 見た目の行数を計る関数.
`text-translate-auto-window-adjust' が t の場合に使用される.
physical-line.el があるかどうかで動作を切り替えてる."
  (save-excursion
    (beginning-of-buffer)
    (do ((num 1))
        ((= (point) (point-max)) num)
      (next-line)
      (if physical-line
          (setq num (+ num 1))
        (progn
          (move-end-of-line nil)
          (setq num (+ num 1 (/ (current-column) (window-width)))))))))

;; google2.el より拝借.
(defun text-translator-url-encode-string (str &optional coding)
  (apply (function concat)
         (mapcar
          (lambda (ch)
            (cond
             ((eq ch ?\n)               ; newline
              "%0D%0A")
             ((string-match "[-a-zA-Z0-9_:/]" (char-to-string ch)) ; xxx?
              (char-to-string ch))      ; printable
             ((char-equal ch ?\x20)     ; space
              "+")
             (t
              (format "%%%02X" ch))))   ; escape
          ;; Coerce a string to a list of chars.
          (append (encode-coding-string (or str "") (or coding 'iso-2022-jp))
                  nil))))

(provide 'text-translator)
;;; text-translator.el ends here

以前のエントリ

• とりあえず暇だったし何となく始めたブログ - Emacs でテキスト翻訳をする
• とりあえず暇だったし何となく始めたブログ - Emacsでエキサイト翻訳を利用するのをちょっと修正した.
• とりあえず暇だったし何となく始めたブログ - Emacsでエキサイト翻訳を利用する

更新時刻

2007年, 4月29日, 5:31