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) 用に修正

2009年10月5日月曜日

applescript:  Safariでページロードを待つ処理

applescriptの、`open location` 命令を使ってSafariを起動し、 開いたページのDOMを `do javascript` 命令でいじくる、 このやり方で、applescriptからSafariを自動制御することが可能だ。
でも、`open location` をした後で、 すぐに `do javascript` 命令を発行しても、 ページの内容が完全にロードされていなかったりして、うまくいかない場合がある。
そこで、それら一連のロード待ち処理を行う、 applescriptのハンドラを書いてみた。

以下がそのサンプルソース。
-- open `theUrl` and check to complete page loading
--   timeoutSec: timeout(sec)
--   Return true if success
on openWithWait(theUrl, timeoutSec)
  tell application "Safari"
    open location "about:blank"
    -- display dialog URL of document 1 as text
    activate
    delay 0.5
    do JavaScript "location.href=\"" & theUrl & "\";" in document 1
    repeat timeoutSec times
      delay 1
      if ((URL of document 1 as text) does not start with "about:") then
        set state to do JavaScript "document.readyState" in document 1
        if (state = "complete") then return true
      end if
    end repeat
    return false
  end tell
end openWithWait

-- Handler that waits for page to be loaded
--   timeoutSec:  timeout(sec)
-- ex. my markDoc() 
--     do JavaScript "document.forms[0].submit();" in document 1
--     if my waitForLoad(30) then ... else ... endif
on waitForLoad(timeoutSec)
  tell application "Safari"
    delay 0.5
    repeat timeoutSec times
      delay 1
      if not my isMarkDoc() then
        set state to do JavaScript "document.readyState" in document 1
        if (state = "complete") then return true
      else
        -- log ("markd")
      end if
    end repeat
    return false
  end tell
end waitForLoad

on markDoc()
  tell application "Safari"
    do JavaScript "document['(@_@)'] = '@_@';" in document 1
  end tell
end markDoc

on isMarkDoc()
  tell application "Safari"
    set scp to do JavaScript "document['(@_@)'];" in document 1
    -- log ("scp=" & scp)
    return scp = "@_@"
  end tell
end isMarkDoc

-- A Sample for openWithWait() and waitForLoad()
-- ( Open wikipedia, and set `applescript` to the textfield, 
--   and then submit form)
tell application "Safari"
  -- set theUrl to "http://en.wikipedia.org/wiki/Main_Page"
  set theUrl to "http://ja.wikipedia.org/wiki/"
  if (my openWithWait(theUrl, 10)) then
    tell document 1
      set title to (do JavaScript "document.title")
      do JavaScript "document.forms[0].search.value = 'applescript';"
      my markDoc() -- Mark current document
      do JavaScript "document.forms[0].submit();"
      if (my waitForLoad(10)) then
        display dialog "Success to open " & title & " and submit"
      else
        display dialog "Cannot submit"
      end if
    end tell
  else
    display dialog "Cannot open " & theUrl
  end if
end tell
サンプルの内容は、Safariでwikipediaを開き、 検索フォームに`applescript`を指定、最後にサブミット、という至って単純なもの。

ここで、openWithWait は、引数で指定したURLをsafariで開き、 新しいウィンドウでのページロード終了を待つハンドラ。うまくいけばtrueを返す。
ページロードの終了を待つのに、 ダミーでブランクページを開いているのがミソ。
document.readyState == "complete"だけで判断すると、 safariが前に表示していた documentをみていたりしてうまく動作しない時がある。 そこで一旦、about:blankを開き、documentのURLがabout: から http: になるのを待ってから、 document.readyStateをチェックするようにしている。

一方 waitForLoad は、ページ遷移後のロード終了を待つハンドラ。 submit()やlocation.href = xxx などの発行後に使う。 これもうまくいけばtrueを返し、失敗すればfalseでリターンする。
一般的な使い方はこんな感じだ。
  tell application "Safari"
    ......................
    -- ページ遷移をさせる前に、 現在のdocumentにダミーの
    -- javascriptプロパティーをマークする
    my markDoc()

    -- ページを遷移させる
    do JavaScript "document.forms[0].submit();" in document 1 

    -- ページロードを待つ (timeoutは10秒)
    if my waitForLoad(10) then
      ..........................
    end if
    ......................
  end tell
ページの遷移を起こす前に、 今見ているdocumentに適当なダミーの属性を与え、 遷移後はその属性が消えている事を確認してから、document.readyState をチェックするという、かなり怪しい方法なのだが.... いちおう動いている。

ところで、Safariでブランクページを表示するURLは、 about:blank というので本当に正しいのだろうか?
about:hoge でも about:qweqwe でも、 about: が付けばなんでもブランクページになるようだが...

2009年10月2日金曜日

elisp: 関数渡しの憂鬱

emacs lispにおいて、関数渡しを行う際の落とし穴。

例えば、
次のような関数my-findを定義したとする。
(defun my-find (pred lst)
  (if lst (if (funcall pred (car lst))
              (car lst) (my-find pred (cdr lst)))
    nil))
my-findは、リストの中からある条件に一致した要素をみつける関数で、 次のように使える。
例1: 奇数を探す
 (my-find (function oddp) '(0 2 -2 3 4)) ; ==> 3 
例2: 負の数を探す場合
 (my-find #'(lambda (x) (< x 0)) '(0 2 -2 3 4)) ; ==> -2 
例3: datasの最初の要素より大きな数を探す場合
  (let ((datas '(3 4 5)))
     (my-find #'(lambda (x) (< (car datas) x)) '(0 2 -2 3 4))) 
  ; ==> 4

しかし、最後の例3において、 dataslstに書き換えると、
  (let ((lst '(3 4 5)))
     (my-find #'(lambda (x) (< (car lst) x)) '(0 2 -2 3 4))) 
  ; ==> nil
となり、これは期待した結果ではない!

何故?
emacs lispの変数束縛は、動的バインディングという方式なので、
(lambda (x) (< (car lst) x))
lstは、定義された場所ではなく使われる場所で評価される。すなわち、 定義された場所の '(3 4 5) ではなく、使われる場所、この場合は関数 my-find
(defun my-find (pred lst) ... )
の第2引数として渡されるlstの値に束縛されるからだ。

ということは、my-findのような関数を引数とする関数を使う場合、 変数の名前がぶつかってしまうと、 意図しない結果を引き起こしてしまう恐れがあるということだ。

さて困った!
この問題を解決するにはどうすればいいのだろう? 僕にはわからない。
とりあえずは、次の二つを心がけるしかないのか。
  • (function (lambda (x) ... ) で関数を渡す時には、なるべく、lambda外部の変数 をlambda内部で使わないようにする。
  • 引数に関数を受け取る関数の定義においては、 なるべく変数を特殊な名前で書くようにする。
  • ex.  (defun my-find (@pred __lst) ... )

ちなみに、静的バインディングで変数を束縛する、 common lisp や scheme では、定義された場所の環境で変数を評価するから、 このような問題は起こらない。
  $ clisp
  [1]> (defun my-find (pred lst)
        (if lst (if (funcall pred (car lst))
              (car lst) (my-find pred (cdr lst)))
           nil))
  [2]> (let ((lst '(3 4 5)))
            (my-find #'(lambda (x) (< (car lst) x))
              '(0 2 -2 3 4)))
  ==> 4

追記  (2009年 10月14日 水曜日)
lexical-let というのを使えば解決できることがわかった。
  (lexical-let ((lst '(3)))
    (my-find #'(lambda (x) (> x (car lst))) '(1 2 3 4 5)))
  ==> 4
lexical-letは名前のとおり、 レキシカルなletバインディングをエミュレートしてくれるマクロだ。 今まで僕が知らなかっただけで、結構有名な機能らしい。 wikipedia にも記述がある。
これを使えばemacs lispでクロージャーを書くことも出来る。
(defun counter-new (n)
  (lexical-let ((n n))
    #'(lambda (cmd)
        (cond ((eq cmd :get) (setq n (+ n 1)) n)
              ((eq cmd :peek) n)
              (t (error (format "%s: illegal command" cmd)))))))
(setq c (counter-new 0))
(setq c2 (counter-new 100))
(funcall c :get) ;==> 1
(funcall c2 :get) ;==> 101
(funcall c :get) ;==> 2
(funcall c :peek) ;==> 2 
もう何十年もemacsと付き合っているが、まだまだ知らない事だらけだ.....