2009年4月23日木曜日

Emacsからはてなキーワードを引く hatena-keyword.el

 現在 Emacs から和英・英和・翻訳・国語辞書・などを SDIC lookup を使って引けるようにしているんですが、電子辞書版の「現代用語の基礎知識」が2007年度版で止まっており、最近のカタカナ語や新語などに対応できていませんでした。

 ということで最近の新語に対応するため、Emacsからはてなキーワードを辞書のように引くものを作ってみました。
 自分で使うには満足な状態なのと、これ以上手を入れる気もなく、埋もれさすのもあれなので公開しておきます。

 最近は小学生の間でも辞書を読むことがブームだそうで。はてなキーワードの散策なんていかがでしょうか。




●インストール

 w3mを使っていますので事前に入れておいてください。
sudo apt-get w3m-el あるいは w3m-el-snapshot

 として w3m を入れたら、~/.emacs に、
(require 'w3m-load)
としておきます。
 後は以下に貼ってあるEmacs lisp を、 hatena-keyword.el という名前で load path の通った場所に保存してください。
 次に ~/.emacs に、
(require 'hatena-keyword)
(global-set-key "\C-ck" 'hatekey)
と追記すればOKです。


●使い方


 調べたい単語の上で C-c k とすれば単語の意味を別ウィンドウで表示します。
 q キーで終了します。
 リンクされたキーワードの上でリターンキーを押すと、そのキーワードを検索して表示します。
 TABキーでキーワードにジャンプします。Shift + TAB で逆順。
 ←キーで過去に表示したキーワードに戻ります。


・hatena-keyword.el

;;; hatena-keyword.el ---

;; Copyright (C) 2009 yama

;; Author: yama <yama.natuki+elisp@gmail.com>
;; Keywords:

;; $Id: hatena-keyword.el,v 1.28 2009/05/03 13:35:06 yama Exp yama $

;; This program 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 3 of the License, or
;; (at your option) any later version.

;; This program 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 this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; はてなキーワードをEmacsから検索して表示するlispです。
;; Emacsからはてなキーワードを辞書のように扱えます。
;; より詳しい情報は、http://ubulog.blogspot.com/

;;; Install

;; (1) emacs-w3m を利用しています。事前に用意して下さい。
;; (2) このファイルをload-pathの通った場所に置きます。
;; (3) ~/.emacs に以下を追記します。
;; (require 'hatena-keyword)
;; (global-set-key "\C-ck" 'hatekey)

;;; Usage:

;; C-c k でカーソル付近の単語を調べます。
;; TABキーでリンクされたキーワードにカーソルを移動します。
;; Shift + TAb で逆順。
;; リンク上でリターンキーを押すとそのキーワードを検索して表示します。
;; リンクがキーワードではない場合はw3mでリンク先を開きます。
;; ←キーで表示したキーワードを戻ることが出来ます。

;;; ToDo

;;



;;; Code:

(require 'url)
(require 'xml)
(require 'w3m)

;;; configuration

(defvar hatenakey-window-height 14
"*Height of window to show entrys and contents.
検索結果表示ウインドウの高さ"
)

(defvar hatena-coding-system 'utf-8
"文字エンコードの指定。utf-8,euc-jp,shift_jis.")



(defconst hatenakey-version "1.1")
(defconst hatenakey-buffer-name "*hatena-word*"
"検索結果表示バッファの名前")

(defconst hatenakey-history-name "*hatena-history*"
"履歴バッファの名前")

(defvar hatenakey-history '()
"履歴スタック")

(defvar hatena-keyword-mode nil
"Non-nil if Hatena Keyword mode is enabled.
Don't change this variable directly, you must change it by one of the
functions that enable or disable Hatena Keyword mode."
)

;; Define keymap
(defvar hatekey-mode-map
(let ((map (make-sparse-keymap)))
(define-key map " " 'scroll-up)
(define-key map "b" 'scroll-down)
(define-key map "q" 'view-kill-window)
(define-key map "\t" 'w3m-next-anchor)
(define-key map [tab] 'w3m-next-anchor)
(define-key map [(shift tab)] 'w3m-previous-anchor)
(define-key map [backtab] 'w3m-previous-anchor)
(define-key map [left] 'hatena-view-previous-page)
(define-key map "\C-m" 'hatena-keyword-jump)
map))


;;; main ------------------------------------------------------

(defun hatekey-version ()
"バージョンを返す。"
(interactive)
(message "hatena-keyword %s" hatenakey-version))


(defun hatena-keyword-mode ()
"はてなキーワード を表示するメジャーモードです.
調べたい文字列の上で \\[
hatekey] を実行することによりキーワードを検索して表示します。
\\<hatekey-mode-map>

key binding
--- -------
\\[
view-kill-window] quit.
\\[
scroll-up] scroll-up
\\[
scroll-down] scroll-down
\\[
w3m-next-anchor] Go to Next Keyword Link
\\[
w3m-previous-anchor] Go to previous keyword Link
\\[
hatena-view-previous-page] Back to History.
\\[
hatena-keyword-jump] jump to keyword
"

(interactive)
(setq major-mode 'hatena-keyword-mode
mode-name "hatekey"
buffer-read-only t)
(use-local-map hatekey-mode-map)
(run-hooks 'hatena-keyword-mode-hook))


(defun hatena-url-restructure (keyword)
"はてなのurlを構築する。"
(concat "http://d.hatena.ne.jp/keyword?word="
(w3m-url-encode-string keyword hatena-coding-system)
"&mode=rss2&ie="
(symbol-name hatena-coding-system)))

(defun my-keyword (url)
"キーワードの解説を返す。"
(interactive)
(set-buffer (url-retrieve-synchronously url))
(if (string-match "200 OK" (buffer-substring (point-min) 20))
(progn
(let* ((root (xml-parse-region (point-min) (point-max)))
(base (car (xml-get-children (car root) 'item)))
(my-desc (nth 2 (car (xml-get-children base 'description)))))
(if (eq my-desc nil) (setq my-desc "No Match") nil)
(if (hatena-buffer-p) (setq buffer-read-only nil))
(set-buffer (get-buffer-create hatenakey-buffer-name))
(erase-buffer)
(insert (decode-coding-string my-desc hatena-coding-system))
(w3m-buffer)
(if (hatena-window-p)
(progn
(select-window (hatena-window-p))
(hatena-keyword-mode))
(split-window-vertically
(- (window-height) hatenakey-window-height))
(set-window-buffer (next-window) (current-buffer))
(select-window (next-window))
(hatena-keyword-mode))))
(message "%s" "Not Found")))


(defun hatena-buffer-p ()
"はてなバッファの存在チェック"
(if (get-buffer hatenakey-buffer-name)
(set-buffer hatenakey-buffer-name)))

(defun hatena-window-p ()
"はてなウィンドウのチェック。"
(get-buffer-window (get-buffer hatenakey-buffer-name)))

(defun hatekey (keyword &optional flag)
"はてなキーワードを検索する。"
(interactive
(list (cond ((or (eq last-command 'mouse-drag-region)
(and (boundp 'transient-mark-mode) transient-mark-mode
(boundp 'mark-active) mark-active)
(eq last-command 'exchange-point-and-mark))
(buffer-substring-no-properties
(region-beginning) (region-end)))
(t (thing-at-point 'word)))
current-prefix-arg))
(if (eq (fboundp 'w3m-buffer) nil) (message "w3m-buffer関数が見つかりません。")
(if flag nil
(let* ((keyword (read-from-minibuffer "Search word: " keyword)))
(my-keyword (hatena-url-restructure keyword))
(hatenakey-history-push keyword)))))


(defun hatenakey-close-window ()
"検索表示バッファを表示しているウインドウを消去する関数"
(interactive)
(let ((w (get-buffer-window hatenakey-buffer-name))
(b (get-buffer hatenakey-buffer-name)))
(if w
(progn
(bury-buffer b)
(if (= (window-height w) hatenakey-window-height)
(delete-window w)
(set-window-buffer w (other-buffer))
(select-window (next-window)))))))

(defun hatena-this-keyword ()
"現在位置のリンクのキーワードを返す。urlならw3mで開く。"
(let ((url (w3m-print-this-url)))
(if (string-match "keyword" url)
(replace-regexp-in-string
"http://d.hatena.ne.jp/keyword/" "" url)
(w3m-browse-url url))))

(defun hatena-keyword-jump ()
"pointのキーワードを検索"
(interactive)
(if (hatena-this-keyword)
(progn
(let ((key (hatena-this-keyword)))
(my-keyword (hatena-url-restructure key))
(hatenakey-history-push key)))))

(defun view-kill-window ()
"検索結果表示ウィンドウを削除する関数"
(interactive)
(if (get-buffer hatenakey-buffer-name)
(progn
(hatenakey-close-window)
(kill-buffer hatenakey-buffer-name)
(setq hatenakey-history '())
(delete-other-windows))))

(defun hatenakey-history-name-p ()
"履歴バッファが存在するかどうか"
(set-buffer (get-buffer-create hatenakey-history-name)))

(defun hatenakey-history-push (keyword)
"履歴にキーワードを追加する。"
(setq hatenakey-history (cons keyword hatenakey-history)))

(defun hatenakey-history-pop ()
"履歴からキーワードを取り出す。履歴からは消える。"
(setq hatenakey-history (cdr hatenakey-history))
(car hatenakey-history))

(defun hatena-view-previous-page ()
"一つ前に見たキーワードへ戻る。"
(interactive)
(my-keyword (hatena-url-restructure (hatenakey-history-pop))))

(provide 'hatena-keyword)
;;; hatena-keyword.el ends here

 きっかけは、現代用語の基礎知識を調べるうちにはてなキーワードが現代用語の基礎知識にいくつか採用という記事を思い出し、じゃあはてなキーワードを辞書代りに使用してもいいんじゃないか。というものでした。
 辞書のように、というのがポイントです。はずせません><

追記:
動作環境書いてなかったorz
ubuntu 8.04.2 LTS、Emacs22,23 emacs-w3m は以前CVSから取ってきたもので動作しています。
w3mどうしましょうかねー。はてなからhtml要素で返ってくるので、フォーマットするのにw3m利用するのが一番簡単で手っ取り早いんですよねえ。その分w3mに依存するけど。
w3m使わなければ可搬性も高まるのだろうけど・・・

追記:
(require 'w3m-load) を書き忘れていたので追記。

追記:2009/04/26
 リンクされたキーワードにジャンプするようにした。
 w3mべったりになった。

追記:2009/05/03
 メジャーモードを実装。履歴を戻る機能を付けた。
 変数を初期化していない凡ミスを直した。

追記:2009/05/04
 コードの色付けが変だったので直した。face2htmlだと量が多いとうまくいかないみたい。htmlizeに変更した。

0 件のコメント: