2009-10-02 text-translator+ 作りました。( extended text-translator.el )
前に考察した奴、全部じゃなくて、一部だけ実装
エントリーしてたこいつ
http://d.hatena.ne.jp/godeatgod/20090929
作るうえで（って、まだ全部実装してないけど）よくわかんないのもあったから、
まずそっちを書きます。
・関数もリストである。
信用しすぎちゃだめ。lisp嫌いになりました。
関数もリストっていうなら、関数内の、あるifだけ変更するって
オーバーライドに仕方が出来ないとだめ！
・・・・・簡単に出来たりするのかな？
・出来るだけletしないと変数汚染しまくり？
グローバル系のセッティング変数は、関数定義直後にletで束縛してあげないと
影響範囲がデカすぎる。
・バッファローカル
バッファオンリーじゃなく、「グローバルだけどバッファ単位で固有」だから、格好悪い。
・文字列の置換
replace-regexp-in-string を使ってるぽいんだけど、動作がよくわからない。
googleしたら id:rubikitchって人がヒットした。この人のanything良いよね。
それはおいといて、1行処理になるのかな？
なら、今回の実装みたいに
point-min => forward
point-max => backward
が良いのではないかな〜って思ったんだけど、相手は id:khikerだから
油断大敵。
変数名を英語にするの苦手だなぁ・・・まぁいいやまず実装したもの
・翻訳はバッファの内容全部だぜーー
・定義してるURL全部訳しまくるぜーー
・その間もemacs操れるんだぜー・・・たぶん？
・結果を一つのバッファに集約します。
初めて、.el拡張子のファイル作ったよって感じなので、
.elとして提供する上で大切なことがあればぜひ教えてください！
.emacsファイルならよく書くんだけどね・・・
では、コードです。あ、yahoo と freetranslation は解析みすったっぽい
コードをコピって、*scratch*を解析させたらおもしろかったです。カンマの扱いとか。
さらに追記： 自分が使えるように作ってるため、検索エンジンは、
(loop for e in text-translator-site-data-alist if (string-match "\\(enja\\)\\|\\(jaen\\)" (car e)) collect (car e))
で絞ってます。
;;; text-translator+.el
;; Description: Extensions to Text Translator
;; => text-translator.el
;; Author: Tomoyuki Kaminishi <god.eat.god4g@gmail.com>
;; Copyright (C) 2009, Tomoyuki Kaminishi, all rights reserved.
;; Keywords: text-translator
;; Compatibility: GNU Emacs 23.x
;; Copyright (C) 2009 Tomoyuki Kaminishi
;; example
;; (global-set-key [f11] 'text-translator+)
;; (global-set-key [C-f11] 'text-translator+-display)
;;; Commentary:
;; Variables for text-translator+
;; use-proxy:url-proxy-services
;;; Code:
(autoload 'text-translator+ "text-translator+" nil t)
(defconst text-translator+-version "0.1"
"version numbers of this version of text-translator+")
(defconst text-translator+-buffer "*translator+*"
"Buffer name that displays translation result.")
(defconst text-translator+-work-bufferformat "*translated:%s"
"all translate buffername: %s => url")
(defvar text-translator+-cleanout-beforstr "")
(make-variable-buffer-local 'text-translator+-cleanout-beforstr)
(defvar text-translator+-cleanout-afterstr "")
(make-variable-buffer-local 'text-translator+-cleanout-afterstr)
(defun text-translator+-display ()
(interactive)
(pop-to-buffer text-translator+-buffer))
(defun text-translator+ ()
(interactive)
(let* (
(translation-str (buffer-substring (point-min) (point-max)))
(engine-all (loop for e in text-translator-site-data-alist
if (string-match "\\(enja\\)\\|\\(jaen\\)" (car e))
collect (car e)))
(engine-buffers (loop for k in engine-all
collect (format text-translator+-work-bufferformat k)))
)
(loop for engine in engine-all
for buffer in engine-buffers
do
(text-translator-client+ engine translation-str buffer)
))
)
(defun text-translator-client+ (engine translation-str work)
(let* (
(process-connection-type nil)
(buffer-read-only nil)
(history-delete-duplicates t)
(type (assoc engine text-translator-site-data-alist))
(proc (open-network-stream
work
work
(or text-translator-proxy-server
(nth 1 type))
(or (and text-translator-proxy-server
text-translator-proxy-port)
80)))
(enc-str
(text-translator-url-encode-string
translation-str (nth 4 type)))
(post-str (format (nth 3 type) enc-str))
(truncate-partial-width-windows nil)
(func-arg1 (nth 5 type))
(straighten-sentences))
(if (functionp func-arg1)
(setq func-arg1 (car (cdr (car (cddr func-arg1))))))
(setq
straighten-sentences
(cond
((string-match-p "\\\\(\\.\\*\\\\)" func-arg1)
(split-string func-arg1 "\\\\(\\.\\*\\\\)" ))
((string-match-p "\\\\(\\[^<\\]\\*\\\\)" func-arg1)
(split-string func-arg1 "\\\\(\\[^<\\]\\*\\\\)" ))))
(with-current-buffer
(get-buffer-create work)
(erase-buffer)
(set-process-coding-system proc (nth 4 type) 'binary)
(set-process-filter proc 'text-translator+-filter)
(process-send-string
proc
(concat
"POST " "http://" (nth 1 type) (nth 2 type) "\r\n"
(and text-translator-proxy-server
text-translator-proxy-user
text-translator-proxy-password
(format "Proxy-Authorization: Basic %s \r\n"
(base64-encode-string
(concat text-translator-proxy-user ":"
text-translator-proxy-password))))
"HOST: " (nth 1 type) "\r\n"
"User-Agent: " text-translator-user-agent "\r\n"
"Accept-Encoding: identity\r\n"
"Accept-Charset: Shift_JIS,utf-8;q=0.7,*;q=0.7\r\n"
"Keep-Alive: 300" "\r\n"
"Connection: keep-alive" "\r\n"
"Content-Type: application/x-www-form-urlencoded\r\n"
"Content-Length: "
(number-to-string (string-bytes post-str)) "\r\n"
"\r\n"
post-str "\r\n"
"\r\n"))
(set-process-sentinel proc
'text-translator+-rendezvous)
(set-buffer (process-name proc))
(setq
text-translator+-cleanout-beforstr
(car straighten-sentences))
(setq
text-translator+-cleanout-afterstr
(car (cdr straighten-sentences)))
)))
(defun text-translator+-filter (proc bufstr)
(with-current-buffer (process-buffer proc)
(insert bufstr)
))
(defun text-translator+-rendezvous (process event)
(let ( (monster)
(pname (process-name process))
)
(with-current-buffer
(get-buffer-create text-translator+-buffer)
(setq monster
(save-excursion
(set-buffer pname)
(let (
(header
(format
"\n===== %s ====="
(cdr (split-string pname ":"))))
(replace-befstr
text-translator+-cleanout-beforstr)
(replace-aftstr
text-translator+-cleanout-afterstr)
)
(goto-char (point-min))
(kill-region
(point-min)
(search-forward replace-befstr) nil)
(goto-char (point-max))
(kill-region
(-
(search-backward replace-aftstr)
(length replace-aftstr))
(point-max) nil)
(goto-char (point-min))
(while
(search-forward-regexp
"<[bB][rR]\\( /\\)?>" nil t)
(replace-match "\n"))
(cons header (buffer-string)))))
(goto-char (point-max))
(insert
(format "\n%s\n%s" (car monster) (cdr monster)))
(kill-buffer pname)
(while (re-search-backward "
" nil t) (replace-match ""))
)))
(provide 'text-translator+)
トラックバック - http://d.hatena.ne.jp/godeatgod/20091002/p1
