もうずいぶん長いこと放置していたが、親キーマップについて。
結論としては、やっぱり C++ の部分を弄らないと無理がありそうなのでやめとこうということになった。そのかわり定義されていない部分だけ他のキーマップと同じにする関数を書いてみた。
(defun adjoin-keymap (kmp sub)
(if (listp sub)
(dolist (entry sub)
(when (consp entry)
(let* ((key (car entry))
(cmd (cdr entry))
(ocmd (lookup-keymap kmp key)))
(if (and (keymapp cmd)
(keymapp ocmd))
(adjoin-keymap ocmd cmd)
(unless ocmd
(define-key kmp key cmd))))
))
(dotimes (i *full-keymap-length*)
(let* ((key (code-char i))
(cmd (aref sub i))
(ocmd (lookup-keymap kmp key)))
(if (and (keymapp cmd)
(keymapp ocmd))
(adjoin-keymap ocmd cmd)
(unless ocmd
(define-key kmp key cmd))))
)))
ldoc の挙動をやや emacs 風に改造してみた。具体的にはカーソル位置のシンボルではなく (up-list -1 t) して目の前にある物の documentation を表示するようにした。引数を書いていて順番を忘れることがよくあるので、この方が便利かなと思って。
それから ldoc2 のソースを読んでいてカーソル位置のパッケージっぽいものを取得している部分があって、これを使って eval-last-sexp を encapsulate することを思いついたのでやってみた。ソースを読んでいると user パッケージから見えないグローバル変数を評価したいことがあるので、そういうときに eval-last-sexp でできるようにした。やり方は簡単で、let で *package* をそれらしいパッケージに束縛しておくだけ。
どっちもただの思いつきでどの程度役に立つかわからないが。
どうでもいいが、*package* をいじって遊んでいて "*package*の値がパッケージではありません" というエラーを初めて見た。
先月 Kamail をダウンロードして make した後ほったらかしにしていたのだが、これを使えるようにしてみようと設定を試みた。認証がうまくいかず二時間ほど悩むが、とりあえず受信はできるようになった気がする。
四ヶ月ぐらい前から初期化ファイルをファイラ関係とかミニバッファ関係とか分割してみることにしている。分割した方がわかりやすいと思ったからなのだが、実際のところそうでもないらしいことが次第に明らかになってきた。
分割してもやっぱりどこに何を書いたのかがわからなくなってしまうことがある。そうするとファイル数が多いほうが探すのは明らかに面倒だ。
かといって元に戻すのも面倒なのだがどうしたものか。
だいぶ前に xyzzy で w3m を使おうとしてバイナリが見つからなかったことがあったが、また探してみたら必要なものが全部集まって使えるようになった。
Windows XP で w3m 0.5.1 をとりあえず動かすの「必要なもの」のところにあるのを集めてきたら動いた。
find-file でのオートモード優先度。
*find-file-auto-mode-function* は、値が関数定義を持つシンボルである時に funcall される。
*automode-parameter-alist* は file parameter の処理に使われ、結果的にモードの設定にも関わる。つまり file parameter としてモードが設定されていて、 *find-file-auto-mode-function* が呼び出されていなければファイル内で指定されたモードがバッファのモードになる。モード設定であるかどうかは alist の cdr 部 (これはシンボルであると仮定される) のプロパティ find-file-auto-mode が non-nil であるかどうかで決まる。これが non-nil であった場合はそれを呼び出した時点でオートモード設定が行われたとみなされる。
*auto-mode-alist* はファイル名に応じてモードを設定するもの。拡張子に応じた設定の場合によく使われる。 get-buffer-file-name が文字列を返す (すなわちバッファがファイルを参照している) と仮定して処理が行われる。
以上の処理はすべて ed::find-file-process-params において行われ、この処理中はモードが設定されたかどうかを表すフラグ auto-mode が動的に束縛される。
英語の直訳みたいな日本語だ。こういう内容の場合にはよくあることではあるが。
set-keymap-parent にやっぱり問題があることが判明。親と子に同じプレフィックスキーが設定されているときにうまくいかない。これに対処するのはかなり面倒、というか次第に無理があることが明らかになりつつある。ソース書き換えて自分で再コンパイルするしかないか。
set-keymap-parent にまだ問題があることが判明。同じキーマップに複数回 set-keymap-parent しようとすると parent が破壊される。まあ修正は難しくないが……というわけで修正。
(defun set-keymap-parent (keymap parent)
(cond ((not (keymapp keymap))
(error (make-condition 'type-error
:datum keymap :expected-type 'keymap)))
((not (keymapp parent))
(error (make-condition 'type-error
:datum parent :expected-type 'keymap)))
((not (consp keymap))
(error "疎でないキーマップに親は設定できません"))
((not (consp parent))
(error "疎でないキーマップは親になれません")))
(let ((tmp keymap))
(loop
(if (or (endp (cdr tmp))
(eq (cadr tmp) 'keymap))
(return-from set-keymap-parent (setf (cdr tmp) parent))
(setq tmp (cdr tmp))))))
初期化ファイルがだいぶ大きくなってきたのでファイルを分割してみようかと思ったが、分割すると起動時のロードが遅くなったりしないだろうかと思ったので試してみた。結論としてはファイル一つあたり数ミリ秒ぐらい余計にかかるらしいが、この程度ならそれほど問題はないだろう。 (参考:*scratch* で実行した様子)
set-keymap-parent を書き直してみた。というか set-keymap-parent がそれらしく動作するように define-key を改造してみた。
(defun set-keymap-parent (keymap parent)
(cond ((not (keymapp keymap))
(error (make-condition 'type-error
:datum keymap :expected-type 'keymap)))
((not (keymapp parent))
(error (make-condition 'type-error
:datum parent :expected-type 'keymap)))
((not (consp keymap))
(error "疎でないキーマップに親は設定できません"))
((not (consp parent))
(error "疎でないキーマップは親になれません")))
(let ((x (last keymap)))
(setf (cdr x) parent)))
(let ((odef #'define-key))
(defun define-key (keymap key command)
(if (consp keymap)
(let ((kmp (cdr keymap))
(prefix (if (consp key) (car key) key))
(rest (safe-cdr key)))
(loop
(let ((entry (car kmp)))
(cond ((eq entry 'keymap)
;; parent を保護しつつ
(let ((save (cdr kmp)))
(unwind-protect
(progn
(setf (cdr kmp) nil) ; 一時的に parent を隠す
(funcall odef keymap key command))
(setf (cdr kmp) save)))
(return))
((eq (car entry) prefix)
(if (and rest (keymapp (cdr entry)))
(define-key (cdr entry) rest command)
(setf (cdr entry) command))
(return))
((null kmp)
(funcall odef keymap key command)
(return)
)))
(setq kmp (cdr kmp))))
(funcall odef keymap key command))
t))
define-key の cond 以下が汚いのはもう少しどうにかならないか。
次のような文字列を書いて最後の閉じ括弧のところで eval-last-sexp すると「一致する括弧が見つかりません」と言われてしばらく悩む。
" ()"
結局のところ原因は beginning-of-defun で "^\\s(" にマッチする場所を探しているからのような気がする。こんなのだと大丈夫。
(read-from-string "\n()") => nil 3
あとこのファイルが lisp-mode で開かれるようになってちょっと驚く。どうやら前のエントリで "-*- Lisp -*-" と書いたらそれが file-parameter だとみなされたらしい。しょうがないのでファイル先頭に本物の file-parameter を書いておくことにした。
キーワードファイルモードでの色付けをキーワードファイル作ってかなり無理矢理やっていたが、そんなことをしなくても編集中のバッファをそのままキーワードファイルとして読み込めばいいことに気付く。気付いたきっかけは、たまたま ~/etc/lisp を眺めていたら最初に "-*- Lisp -*-" って書いてあるのが目にとまったこと。書いてあるのは前から知っていたが、キーワードファイルを開いたバッファを当該モードにすることで編集中に表示が確認できるということに気付いていなかった。
バッファが変更されるたびに自動的に色を変えたかったので post-buffer-modified-hook を使ってリロードしてみた。重くなるかと思っていたがそうでもないようなので一安心。
ちょっと不満があるとすれば、キーワードファイルをあらかじめロードしておかないとうまくいかないというところ。まあもうちょっと頑張れば修正はできるんだけど。
set-keymap-parent の修正はよく考えてみたらやっぱりうまくいってなかった。どうしても define-key した時に親キーマップが破壊される可能性が残る (lookup-keymap に見えるところは全部破壊されうる) ので、ちゃんと対応しようとすると define-key を上書きするか keymap.cc を書き換えて自分でコンパイルするしかなさそうだ。後者は VC++ でないといろいろと面倒臭そうなので対応するとしたら前者の方法になるだろうな。
encapsulate はクロージャ (新しい関数の本体になる) に評価されるフォームを生成する関数を作って encapsulate 自体をマクロにしたらうまくいってるような気がする。妙に長くなってしまったが。
前に定義した set-keymap-parent が複数ストロークが絡んだときに正しく動作しない場合があることが判明。しかも define-key したときに親キーマップが破壊されてしまう。 keymap.cc を一通り眺めた感じでは、対処できなくはなさそうだけどちょっと面倒だなあ。
encapsulate で関数定義を変更すると ldoc で引数が見えなくなってしまうのが少し気になっていたので何とかしてみようと思っていくつかコードを書いてみた。それなりに対応できたかに見えたが argument-list が使えなくなるのであまり嬉しくない。関数定義内で無理矢理 argument-list を束縛してみてもなんかいろいろうまくいかない。
ウィンドウ周りのことが今までよく分かってないような気がなんとなくしてはいたものの何が分かってないのかもよくわからなかったのだが、どうやらバッファの表示状態はウィンドウごとに異なる可能性があるということをちゃんと認識してなかったらしい。
気がついた経緯 (に似たシチュエーション) 。ウィンドウが二つに分割されているとし、便宜上それらを A, B と呼ぶことにする。 A, B にはそれぞれ *scratch* および *stacktrace* バッファが表示されているとし、下のコードを *scratch* で評価する。
;; (1)
(save-excursion
(other-window 1)
(scroll-window 1)
(other-window -1))
;; (2)
(let ((buf (prog2
(other-window 1)
(window-buffer (selected-window))
(other-window -1)
)))
(set-buffer buf)
(scroll-window 1))
;; (3)
(progn
(set-buffer "*stacktrace*")
(set-window (get-buffer-window (selected-buffer)))
(scroll-window 1))
このとき (1) を評価すると B がスクロールするが (2), (3) では B はスクロールせず、かといって A がスクロールするわけでもない。バッファが *stacktrace* にセットされた状態で scroll-window しても、それを表示しているウィンドウ (B) がスクロールするとは限らないということか。それではどういう場合にスクロールするのだろうか。 (1), (2) の比較からすると set-window しておけばよいのではないかと思ったが (3) がそうとも限らないことを示している。さて一体どうなっているのだろうかとしばらく悩んだ。
実際のところはどうなっているかというと、各ウィンドウごとにバッファの表示は別々になっていて、 (2), (3) の場合にはウィンドウ A における *stacktrace* の表示が変わっているということのようだ。実際、これを評価する前後に C-x b *stacktrace* などとして A で *stacktrace* を表示してみると、評価後にはスクロールしていることが確かめられる。
リングを使ってみようと思ったけどよく見てみたら思ったほどできることが多くないようなのでとりあえずやめておくことにする。
考えてみたらリングを使いたい場合ってそんなにないかもしれない。マークリングみたいなものを使いたいことはあるが、リストで代用できる場合が多いような。実際 *kill-ring* はそうなっているしマークリングだってそれで問題なく動作している。
長さが固定なら実際にデータを格納する場所は配列にして始めと終わりがわかるようにインデックスを保持しておいたほうが効率がいいかもしれないが、 *kill-ring* のような場合は長さがせいぜい数十程度だから、リストにして要素を追加するたびに長さをチェックしたりしてもたいして時間はかからない。何万回もそういう操作をやらせるならそれなりに差が出るかもしれないが、エディタのコマンドのような場合はそんなことはまずないのでリストで十分ということなのだろう。
なんか双方向リストが使いたいことがあったので探してみたら、ちょっと違うけど elisp でリングが実装されていたので移植してみた。移植といっても aset, setcar, copy-sequence をそれぞれ対応する関数名に置き換えるのと最後のほうで使っている mapcar を coerce で書き換えるだけで特に問題なく動作しているような気がする。
今回本当に使いたいのはリングじゃなくて双方向リストだったのだが、まあマークリングあたりに使ってみることにしようか (別に ML にあったのを使ってもほとんど変わらないけど) 。
HTML 関連 Tips になんとなく刺激を受けて、何か書いてみたくなった。でも使いもしないものを書いても仕方がない (他の人にとって便利なら別かもしれないが……) 。とりあえず今欲しいものをということで、キルリングからソースコードを貼り付けるコマンド。必要に応じて実体参照への変換と untabify も勝手にしてくれる。思いっきり自分専用な書き方してるけど (下から二行目が) 。
(defun html-yank-code (&optional rev)
(interactive "P")
(let ((p (point))
(str (car (ed::current-kill 0))))
(setq str
(substitute-string
(substitute-string
(substitute-string
(substitute-string
(substitute-string
str
"&" "&")
"<" "<")
">" ">")
"\"" """)
"\t" (make-sequence 'string (tab-columns (selected-buffer))
:initial-element #\SPC)))
(with-output-to-selected-buffer
(format t "<pre class=\"code\">\n~A~&</pre>" str))
(if rev (goto-char p))))
実は前からキーボードマクロの実行が途中で止まってしまうのが気になっていたのだが、これの原因が判明。去年の 10/15 に書いたマクロのせいだった。これを使ったマクロを C-f とか C-n とか C-e とかに割り当てていたせいでキーボードマクロがまともに機能しなくなっていた。
このマクロで定義したコマンドは必ず nil を返す。そして、コマンドが nil を返すと command-execute はそこで終了してしまうようだ。 command-execute (builtin.l) → Fcommand_execute (eval.cc) → execute-string (toplev.cc) と辿ると次のような部分がある (l.1861-) 。
result = dispatch (c);
if (result == Qnil)
return result;
どうやらここでコマンドの実行結果 (result) が nil であると return してしまうため、キーボードマクロの実行が途中で止まる形になるらしい。
で、修正した定義はこんなの。これでいいのかどうかはやや自信がないが。
(defmacro define-S-sensitive-cmd (name cmd S-cmd)
`(defun ,name (&optional (arg 1))
(interactive "p")
(if (minusp (GetKeyState #x10)) (setq arg (- arg)))
(let ((com (if (plusp arg) ',cmd ',S-cmd)))
(dotimes (_ (abs arg) t)
(unless (funcall com)
(return nil))))))
mayu ファイルを久しぶりに編集。これまで #\TAB は indent-relative にバインドされていたが、シンボルを使ってみたら条件分岐のところで mayu-indent-line を使いたくなる。そこでこんなのを書いてみた(実際はフックにひっかけているが)。 c-mode とかで行末にコメントを書く人は似たようなことをしているとか。
(define-key ed::*mayu-mode-map* #\TAB
(lambda ()
(interactive)
(call-interactively
(if (save-excursion
(skip-syntax-spec-backward " ")
(bolp))
'ed::mayu-indent-line
'indent-relative))))
あとは初期化ファイルの整理なんかをやっていたりする。一部を user-config-path 以下に置いてみたり。そのうち公開するかもしれない。
こんなのを書いてみた。モード毎にキー配列を変えたいときなんかにちょっと書くのが簡単になる。
(defun define-keys (keymap alist)
(flet ((f (c)
(lambda (&optional (arg 1))
(interactive "*p")
(setq *last-command-char* c)
(self-insert-command arg)
(setq *this-command* 'self-insert-command))))
(dolist (b alist)
(define-key keymap (car b)
(if (characterp (cdr b))
(f (cdr b))
(cdr b))))))
例えばこんな使い方を想定。
(define-keys ed::*lisp-mode-map*
'((#\3 . #\#)
(#\4 . #\()
(#\8 . #\))
(#\9 . dabbrev-expand)))
こんなことをやってみた。何かキーを入力すると止まる。
(setq *read-default-float-format* 'double-float)
(let ((c 0)
(a 1.0)
(e 1.0)
(p (point)))
(loop
(if (read-char-no-hang *keyboard*) (return))
(setq c (1+ c)
a (/ a c)
e (+ e a))
(delete-region p (point))
(insert (format nil "~16A" e))
(refresh-screen)))
収束する様子を眺めてみようと思ったが、やってみたら全然面白くなかった。円周率でやればよかったかもしれないが級数をすぐに思い出せなくて、こんなことのためにわざわざ調べるのも面倒で。まあ、収束する様子が観察できたからどうってわけでもないんだけど。
ミニバッファ周りでの IME の制御。前に書いたような気がするけどそれの refinement 。初めて svar を使ったような気がする。でもよく見るとこのコードではあまり役に立ってない。
(defvar *ime-state-save* nil)
(defun save-ime-state (&optional (stat nil sv))
(setq *ime-state-save* (buffer-ime-mode))
(if sv (toggle-ime stat)))
(defun restore-ime-state () (toggle-ime *ime-state-save*))
(add-hook '*enter-minibuffer-hook*
#'(lambda (b h) (save-ime-state nil)))
(add-hook '*exit-minibuffer-hook*
#'(lambda (b h) (restore-ime-state)))
(encapsulate 'isearch-forward 'ime
'((interactive)
(save-ime-state nil)
(unwind-protect
(apply basic-definition argument-list)
(restore-ime-state))))
やっぱり正規表現じゃなくてもできた。けど #\* を set-syntax-symbol しないといけないことに気付かずにしばらく悩んだ。
(defvar *kwd-mode-map* nil)
(defvar *kwd-mode-hook* nil)
(defvar *kwd-mode-regexp-keyword* nil)
(defvar *kwd-mode-syntax-table* nil)
(defvar *kwd-keyword-hash-table* nil)
(unless *kwd-mode-map*
(setq *kwd-mode-map* (make-sparse-keymap)))
(unless *kwd-mode-syntax-table*
(setq *kwd-mode-syntax-table*
(let ((table (make-syntax-table)))
(set-syntax-symbol table #\*)
table)))
(unless *kwd-keyword-hash-table*
(setq *kwd-keyword-hash-table*
(load-keyword-file "~/kwd/kwd" t)))
(defun make-kwd-mode-keyword-file (file)
(interactive "FMake keyword file: ")
(if (file-exist-p file)
(unless (y-or-n-p "File ~A already exists. Overwrite it?" file)
(return)))
(with-open-file (s file :direction :output)
(let (attstr spec)
(dotimes (att 16)
(setq attstr (concat (if (plusp (logand #x1 att)) "b")
(if (plusp (logand #x2 att)) "u")
(if (plusp (logand #x4 att)) "s")
(if (plusp (logand #x8 att)) "l")
))
(dotimes (col 19)
(setq spec (format nil "*~20R~A" col attstr))
(format s ";~A~%~:*~A~%" spec))
(dotimes (fg 16)
(setq spec (format nil "**~X" fg attstr))
(format s ";~A~%~:*~A~%" spec)
(dotimes (bg 16)
(setq spec (format nil "**~X~X~A" fg bg attstr))
(format s ";~A~%~:*~A~%" spec)))))))
(defun kwd-mode ()
(interactive)
(kill-all-local-variables)
(make-local-variable 'keyword-hash-table)
(setq keyword-hash-table *kwd-keyword-hash-table*
buffer-mode 'kwd-mode
mode-name "kwd")
(use-keymap *kwd-mode-map*)
(use-syntax-table *kwd-mode-syntax-table*)
(run-hooks '*kwd-mode-hook*)
; (make-local-variable 'regexp-keyword-list)
; (setq regexp-keyword-list *kwd-mode-regexp-keyword*))
)
M-x make-kwd-mode-keyword-file でプロンプトからファイル名を入力するとそこにキーワードファイルを書き出す(76,400 Bytes)。ファイルサイズはもう数KBぐらい減らせると思うけど、面倒なのでこれでいいことにした。
キーワードの表示をカスタマイズするのが結構楽しい。調子に乗ってキーワードファイル用メジャーモードを作ってしまった。といってもどこにでもあるような雛型ほとんどそのままで、自分で作ったのは実質正規表現キーワードぐらい。というか単に色指定をしているところを実際の表示色どおりに色付けしたかったから作っただけだが。
で、上の文書いてて思ったんだが正規表現にする必要あったんだろうか？普通のキーワードで何とかなるんじゃないかという気がしなくもないのだが。先頭のセミコロンには色がつかないかもしれないが。
;;; keyword file mode
(defvar *kwd-mode-map* nil)
(defvar *kwd-mode-hook* nil)
(defvar *kwd-mode-regexp-keyword* nil)
(defvar *kwd-mode-syntax-table* nil)
(unless *kwd-mode-map*
(setq *kwd-mode-map* (make-sparse-keymap)))
(unless *kwd-mode-syntax-table*
(setq *kwd-mode-syntax-table* (make-syntax-table)))
(setq *kwd-mode-regexp-keyword*
(compile-regexp-keyword-list
(revappend
(let (list)
(dotimes (col 18 list)
(push `(,(format nil "^;\\*~X[busl]*$" col)
t (:keyword ,col :underline))
list)))
(let (list)
(dotimes (fg 16 list)
(push `(,(format nil "^;\\*\\*~X$" fg)
t (:color ,fg 0 :underline))
list)
(dotimes (bg 16)
(push `(,(format nil "^;\\*\\*~X~X[busl]*$" fg bg)
t (:color ,fg ,bg :underline))
list))))
)))
(defun kwd-mode ()
(interactive)
(kill-all-local-variables)
(setq buffer-mode 'kwd-mode
mode-name "kwd")
(use-keymap *kwd-mode-map*)
(use-syntax-table *kwd-mode-syntax-table*)
(run-hooks '*kwd-mode-hook*)
(make-local-variable 'regexp-keyword-list)
(setq regexp-keyword-list *kwd-mode-regexp-keyword*))
キーワードファイルを複数ロードして keyword-hash-table を上書きできるということに今日気付いた。早速 HTML と lisp のキーワードファイル差分を適当に作成してみた。