read-stringがインクリメンタルじゃないのが何かと面倒

とか思ったので、インクリメンタル風にread-stringっぽい事をする奴を作ってみた。本当はここに刺激されてやってみただけだけど。
　PC的にも非力で困ったりしない今となっては便利に動いてくれた方が良さそうだし、UI的には何かとインクリメンタルな感じで動いてくれた方が嬉しいんだけど、read-stringしかないので何時もread-stringとか(interactive "sHoge:")見たいなのを使う事になる。しかし、インクリメンタルに動かないのでloopとかして毎回書くのが何か微妙に思えたので。isearchとかを適当に参考にして汎用性がありそうな感じで出来たら良いかと試してみた。

取り合えず作った、シンプルな感じの

(defvar *iread-current-string* nil)
(defvar *iread-string-this-command* nil)
(defvar *iread-string-command-char* nil)
(defvar *iread-string-self-insert* nil)

;;keymap
(defvar *iread-string-map* nil)
(unless *iread-string-map*
  (setq *iread-string-map* (make-sparse-keymap))
  (define-key *iread-string-map* #\C-g 'quit)
  (define-key *iread-string-map* #\RET 'iread-string-exit)
  (define-key *iread-string-map* #\C-h 'iread-delete-char))

;; core
(defun iread-string (&key (prompt "iread:")
			             (istr "")
						 (keymap *iread-string-map*)
						 (func (symbol-function 'key-test)))
  (interactive)
  (let ((*iread-current-string* istr)
	(*iread-string-map* keymap)
	(*iread-string-this-command* nil)
	(*iread-string-last-command* nil)
	(*iread-string-self-insert* func))
    (setq *last-iread-string-regexp-p* nil)
    (unwind-protect
	(catch 'iread-string-exit
	  (loop
	    (refresh-screen)
	    (minibuffer-prompt "~a~a" prompt *iread-current-string*)
	    (let ((*iread-string-command-char* (read-char *keyboard*)))
	      (setq *iread-string-this-command* (lookup-keymap *iread-string-map*
							  *iread-string-command-char* t))
		  (if (graphic-char-p *iread-string-command-char*)
			  (setq *iread-current-string*
					(concat *iread-current-string*
							(string *iread-string-command-char*))))
	      (if *iread-string-this-command*
			  (funcall *iread-string-this-command*)
			(funcall *iread-string-self-insert* *iread-string-command-char*))
	      (setq *iread-string-last-command* *iread-string-this-command*)
		))))
	*iread-current-string*))

;; iread-string basic function
(defun iread-string-exit()
  (unless (string= *iread-current-string* "")
	(setq *last-iread-string* *iread-current-string*))
  (throw 'iread-exit t))

(defun iread-delete-char ()
  (let ((l (length *iread-current-string*)))
	(if (zerop l)
	    (ding)
	  (setq *iread-current-string* (subseq *iread-current-string* 0 (- l 1))))
	(funcall *iread-string-self-insert* *iread-string-command-char*)
	(setq *iread-this-command* 'iread-delete-char)))

;; dummy 
(defun key-test(c)
  (message "key ~C string ~A" c *iread-current-string*))

動かす時は

;; test function
(defun tester()
  (interactive)
  (iread-string :prompt "hoge:" :istr "hoge"))

　こんな感じで、引数に色々仕込むと動く。key-testはキーを押すごとに動かす関数を何もなしにしておくとエラーが出ちゃうので、入れ忘れても困らない程度のダミー、一応こういう風に動くというサンプル的にも良いかと思って放置。履歴くらい入れたほうが良かったかもしれないけど、履歴って結構面倒そうだったので放置。
　書き方は、dolistとかみたいに中でlisp書いた方が良いのかもしれないが、マクロとかよく分からなかったのでやめた。

■以下通販風味のサンプル
TVショッピングの怪しげな外人：ちょっと待ってくれよスティーブ！
スティーブ：なんだいジョニー？
ジョニー：これが便利そうなのは分かったんだけど、実際にはどうやって使うんだい？
ジョニー：例えばインクリメンタルサーチを作ってみたいんだけどどうしたらいいのかな？
スティーブ：簡単さ。単純な操作で、誰でもイケてる動作が出来るんだ。ちょとっと見ててくれよ。
スティーブ：まず、ダミーのkey-testの変わりに動作する関数を作るんだ。例えば

(defun scan(c)
  (scan-buffer *iread-current-string*)
  (refresh-screen))

ジョニー：これは何時もの単純な関数だね。
スティーブ：これを、インクリメンタルに実行したい場合は。これだけでいいんだ。

(defun tester()
  (interactive)
  (iread-string :func 'scan))

スティーブ：これで簡単なインクリメンタルサーチが出来上がりさ。*1
ジョニー：え？こんな簡単に？
スティーブ：そうさ。とてもシンプルなんだ*2
ジョニー：これは凄いね何だか僕でも出来そうな気がしてきたよ。
ステューブ：そうさ、誰でも簡単にできるんだよジョニー。ＨＡＨＡＨＡ。

*1::funcの所は(symbol-function 'hogehoge)にした方がいいかもしれない。

*2:検索が