2009年10月19日月曜日

emacsから翻訳サイトをアクセス

emacsからSafariを起動し、 googleやexciteの翻訳ページをアクセスするコマンド。 たぶん、leopardでしか動作しないと思う。

browse-translate-site.el
(defun my-escape-url (str &optional encoding)
  "URL-encode a string. ENCODING default is 'utf-8"
  (mapconcat
   (lambda (ch)
     (if (or (and (<= ?A ch) (<= ch ?Z)) (and (<= ?a ch) (<= ch ?z))
             (memq ch (list ?_ ?. ?-))) (char-to-string ch)
       (format "%%%02X" ch)))
   (encode-coding-string str (if encoding encoding 'utf-8)) ""))
(defun escape-js-string (str)
  "Escape string to javascript string literal"
  (apply #'concat
         (mapcar
          #'(lambda (c)
              (cond
               ((= c ?\\ ) "\\\\") ((= c ?\" ) "\\\"") 
               ((= c ?\' ) "\\'")  ((= c ?\t ) "\\t")
               ((= c ?\012) "\\n") ((= c ?\015) "\\r")
               ((= c ?\010) "\\b") ((= c ?\014) "\\f")
               ((< c 32) (format "\\u%0.4x" c))
               (t (char-to-string c)))) str)))
(cond
 ((and (<= emacs-major-version 22)
       (string-match
        ".*:1:14" (format "%s" (getenv "__CF_USER_TEXT_ENCODING"))))
  ;; emacs22 and CFUserTextEncodingが MacJapanese の場合
  (defun applescript-string-literal (str)
    "do-applescriptに渡す文字列リテラルを作成"
    (let ((reslst '()))
      (mapc
       '(lambda (ch)
          (cond ((= ch ?\\) (setq reslst (cons 128 reslst)))
                ((= ch ?\") (setq reslst (cons 34 reslst)))
                ((consp (car reslst))
                 (setcar reslst (cons ch (car reslst))))
                (t (setq reslst (cons (list ch) reslst)))))
       str ;; (append str nil)
       )
      (if (null reslst) "\"\""
        (mapconcat
         '(lambda (x)
            (if (consp x)
                (concat "\"" (reverse x) "\"")
              (format "ascii character %d" x))
            ) (reverse reslst) " & ")) 
      )))
 (t ;; emacs23 or CFUserTextEncodingがMacJapanese以外の場合(暫定)
  (defun applescript-string-literal (str)
    "do-applescriptに渡す文字列リテラルを作成"
    (concat "\""
            (replace-regexp-in-string ;; convert " => \"
             "\\\"" "\\\\\""         
             (replace-regexp-in-string ;; convert \ => \\
              "\\\\" "\\\\\\\\"
              str)) "\""))))

(defun safari-script-open ()
  "on openWithWait(theUrl, timeoutSec) \n\
     tell application \"Safari\" \n\
       open location \"about:blank\" \n\
       activate \n\
       delay 0.5 \n\
       do JavaScript \"location.href='\" & theUrl & \"';\" in document 1 \n\
       repeat timeoutSec times \n\
         delay 1 \n\
         if ((URL of document 1 as text) does not start with \"about:\") then \n\
           set state to do JavaScript \"document.readyState\" in document 1 \n\
           if (state = \"complete\") then return true \n\
         end if \n\
       end repeat \n\
       return false \n\
     end tell \n\
   end openWithWait \n\
\n\
   on waitForLoad(timeoutSec) \n\
     tell application \"Safari\" \n\
       delay 0.5 \n\
       repeat timeoutSec times \n\
         delay 1 \n\
         if not my isMarkDoc() then \n\
           set state to do JavaScript \"document.readyState\" in document 1 \n\
           if (state = \"complete\") then return true \n\
         else \n\
           -- log (\"markd\") \n\
         end if \n\
       end repeat \n\
       return false \n\
     end tell \n\
   end waitForLoad \n\
   on markDoc() \n\
     tell application \"Safari\" \n\
       do JavaScript \"document['(@_@)'] = '@_@';\" in document 1 \n\
     end tell \n\
   end markDoc \n\
   on isMarkDoc() \n\
     tell application \"Safari\" \n\
       set scp to do JavaScript \"document['(@_@)'];\" in document 1 \n\
       -- log (\"scp=\" & scp) \n\
       return scp = \"@_@\" \n\
     end tell \n\
   end isMarkDoc ")

(defun translate-with-excite (text is-waei)
  "TEXTをexciteで翻訳する。IS-WAEIが t ならば和英、nilならば英和"
  (do-applescript
   (concat
    (safari-script-open) "\n"
    (encode-coding-string
     (format "\
   tell application \"Safari\" \n\
     set theUrl to \"http://www.excite.co.jp/world/\" \n\
     if (my openWithWait(theUrl, 40)) then \n\
       tell document 1 \n\
         set orgsent to %s as unicode text \n\
         do javascript \"document.forms.world.before.value = '\" & orgsent & \"';\" \n\
         do javascript \"document.forms.world.wb_lp.selectedIndex = %s;\" \n\
         my markDoc() \n\
         do javascript \"document.forms.world.submit();\" \n\
         if (my waitForLoad(30)) then \n\
           set aftval to do javaScript \"document.getElementById('after').value\" \n\
           set the clipboard to aftval \n\
         else \n\
           display dialog \"Cannot submit\" \n\
         end if \n\
       end tell \n\
     else \n\
       display dialog \"Cannot open \" & theUrl \n\
     end if \n\
   end tell \n"
             (applescript-string-literal (escape-js-string text))
             (if is-waei 1 0))
     (if (>= emacs-major-version 23) 'utf-8 'sjis-mac) )))
  )

(defun translate-with-google (text from-lang to-lang)
  "Translate TEXT FROM-LANG into TO-LANG with google\n\
   from-lang, to-lang:    en,ja ...\n\
   The translation result is copied into the clipboard. "
  (let ((url
         (format
          "http://translate.google.co.jp/translate_t?prev=hp&hl=ja&js=y&text=%s&sl=%s&tl=%s"
          (my-escape-url text 'utf-8)
          from-lang to-lang)))
    (do-applescript
     (concat
      (safari-script-open) "\n"
      (format "\
   tell application \"Safari\" \n\
     set theUrl to \"%s\" \n\
     if (my openWithWait(theUrl, 30)) then \n\
       tell document 1 \n\
         set rval to do javaScript \"document.getElementById('result_box').innerText\" \n\
         set the clipboard to rval \n\
       end tell \n\
     else \n\
       display dialog \"Cannot open \" & theUrl \n\
     end if \n\
   end tell \n" url)))))

(defvar browse-translate-japanese-hist nil)
(defun browse-translate-japanese (s e)
  "Translate region text into japanese or english\n\
   If 8-bit character is included in the region then translates into English,\n\
  otherwise translates into Japanese. \n\
   The translation result is copied into the clipboard. \n\
   Translate engine is google or excite, default is excite"
  (interactive "r")
  (save-excursion
    (let ((text (buffer-substring-no-properties s e)))
      ;; (let ((waei-p (multibyte-string-p text)))
      (let ((waei-p (string-match "[^\000-\177]"
                                  (encode-coding-string text 'utf-8))))
        (let ((engine
               (read-from-minibuffer
                (format "%s using x(excite) or g(google) > "
                        (if waei-p "To ENGLISH" "To JAPANESE" ))
                (if (consp browse-translate-japanese-hist)
                    (car browse-translate-japanese-hist) "x")
                nil nil 'browse-translate-japanese-hist)))
          (cond ((member engine '("g" "G" "google")) ;; use google
                 (translate-with-google
                  text (if waei-p "ja" "en") (if waei-p "en" "ja")))
                ((member engine '("x" "X" "e" "excite")) ;; use excite.co.jp
                 (translate-with-excite text waei-p))
                (t (message "Unknown translate engine"))))))))

インストール

  1. 上のソースを、browse-translate-site.el というファイルにセーブ
  2. browse-translate-site.el をどこか、load-pathが切ってあるフォルダーに移動。
  3. (ex. $ sudo mv browse-translate-site.el /Applications/Emacs.app/Contents/Resources/site-lisp/ )
  4. .emacs.el に以下を追加
  5. (autoload 'browse-translate-japanese "browse-translate-site"
              "Translate region text into japanese or english" t nil)
    (global-set-key "\C-ch" 'browse-translate-japanese)
    
  6. emacs再起動

使い方

  • emacsのバッファーでリージョンを指定し、Control-C と h を叩く。
  • ミニバッファーに何か聞いてくるので、 excite翻訳なら x を、google翻訳なら g を指定。
  • Safariが開き、exciteなりgoogleの翻訳結果が表示されるはず。 (exciteの時はちょっと時間がかかる)

翻訳結果はクリップボードにコピーされるので、必要なら、 emacsに戻って結果をペーストすることもできる。また、英訳するか和訳するかは、 リージョンに8bit文字があれば英訳、なければ和訳するように判断させている。

elispの中で使っているapplescriptは、 Safariでページロードを待つ処理 を参照。
__CF_USER_TEXT_ENCODING を、 標準の ユーザID:1:14 以外に設定していると、日本語が変になって動かないかもしれない。

追記  (2009年 11月4日 水曜日)
cocoa emacs (emacs23.1) 用に修正

0 件のコメント:

コメントを投稿