数十行程度の小細工 emacs lisp です。主に Cocoa Emacs (emacs 23.0.94.1) 上で動作確認しています。mule と聞いたらラバのことだと思っているので悪しからず。これらのコードは、頻繁に訂正しています。ご利用は自己責任で。太字になっているものは使用頻度高いです。
.emacs.el で完結することを目指して、必要十分な機能のみを可能な限り短いコードで書く方針のため、コードは短く読みにくく、代替の emacs lisp が既にある場合もあります。コードの環境依存性が高く、例外に対して脆弱かもしれません。
Window の emacs は UNIX に比べて起動がかなり遅いのですが、多少工夫すると起動速度を改善することが出来るようです。そのために役立つ emacs lisp です。
Meadow（1.15 以前）のフォント設定は、README.Meadowにありますが、ハイレベルAPIでの設定だと、どうも時間がかかってしまうようです（PIII 850 MHzの環境で起動 7 秒中 5 秒くらいは取られている感じ）。
一方、ローレベルAPIで設定すると、今度は逆にゴミが残ったりして、なかなかうまくいきません。どうしたもんかな、Meadow メーリングリスト アーカイブを眺めていたらハイレベル API で設定した fontset の情報をキャッシュとして書き出す方法が書いてある記事を見つけました（[MD:2019] change-fontset-from-request can't change Japanese-italic-fonts.）。
というわけで、この記事にある、mw32x-fontset-cache.elを取ってきて、今は、
(cond
(run-meadow1
(progn
(require 'mw32x-fontset-cache)
(setq mw32x-fontset-name "fontset-tt16")
(cond ((file-readable-p "~/.meadow-fontset-cache.el")
(mw32x-fontset-load))
(t
(message "Fontset-cache file doesn't exist. Now creating ...")
(create-fontset-from-request
"fontset-tt16"
'((width . 8) (height . 16) (fixed . t) (italic . nil))
'((family . "SH G30-M") (family . "Andale Mono")))
(change-fontset-from-request
"fontset-tt16"
'((width . 8) (height . 16) (fixed . t) (weight . 800) (italic . nil))
'((family . "SH G30-M") (family . "Andale Mono"))
1)
(change-fontset-from-request
"fontset-tt16"
'((width . 8) (height . 16) (fixed . t) (italic . nil))
'((family . "SH G30-M") (family . "Andale Mono"))
2)
(change-fontset-from-request
"fontset-tt16"
'((width . 8) (height . 16) (fixed . t) (weight . 800) (italic . nil))
'((family . "SH G30-M") (family . "Andale Mono"))
3)
(mw32x-fontset-save)
(byte-compile-file "~/.meadow-fontset-cache.el"))))))みたいな感じになってます。変更したときには、~/.meadow-fontset-cache.{el,elc}を消してください。フォント設定を別ファイルにして、変更があったらロードし直すみたいな感じにした方が良いかもしれない。ここの環境だと起動時間が5,468msec. -> 1,104msec.になりました。
単に、色々なサイズのフォントの設定をまとめたもの。function を使った定義方法を試してみた。Andale Mono の高さを少し低くしている。
(dolist (size '(14 16 18 20 22))
(w32-add-font
(concat "fontset-tt" (number-to-string size))
`((spec
((:char-spec any :height any :weight any :slant any)
function
(lambda (char attrs frame)
(let ((height ,(- size)) (width ,(- (/ size 2)))
(en "Andale Mono") (ja "SH G30-M"))
(if (eq (plist-get attrs :height) 'unspecified)
(list 'w32-logfont en width height 400 0 nil nil nil 0 1 3 49)
(let* ((charset (char-charset char))
(weight (if (eq (plist-get attrs :weight) 'bold) 700 400))
(slant (if (eq (plist-get attrs :slant) 'italic) t nil)))
(list (cond ((eq charset 'ascii) ;; 高さを微調整
(list 'w32-logfont en width (+ 1 height) ;; *
weight 0 slant nil nil 0 1 3 49))
((eq charset 'japanese-jisx0208)
(list 'w32-logfont ja width height
weight 0 slant nil nil 128 1 3 49)))
`((spacing . ,(if (eq weight 700) -1 0))))
))))))))
(set-face-attribute 'variable-pitch nil
:font (concat "fontset-tt" (number-to-string size))))追記 (04/11/11): 上記では、アルファベットと日本語とでフォント幅の細かい調節をしているが、最近の meadow 2.10, 2,20 系列では起動時にクラッシュしてしまうようになった。調べたところ、どうも[meadow-users-jp 5771] Re: Meadow-2.10-dev(20040702)のフォントの設定についての変更が原因らしい。対処法としては、mw32font.c のバージョンを戻して build した meadow を使うか、* の行で高さの調整をしないようにすれば良いようだ。高さの調整は出来なくなったのだろうか。
.emacs 中に
(defun my-time-lag ()
(let* ((now (current-time))
(min (- (car now) (car my-time-zero)))
(sec (- (car (cdr now)) (car (cdr my-time-zero))))
(msec (/ (- (car (cdr (cdr now)))
(car (cdr (cdr my-time-zero))))
1000))
(lag (+ (* 60000 min) (* 1000 sec) msec)))
(message "'.emacs.el' loading time: %d msec." lag)))と書いて、.emacs の先頭に,
(defconst my-time-zero (current-time)).emacs の最後に
(add-hook 'after-init-hook (lambda () (my-time-lag)) t) ;; (2004/01/01 変更)と書くと .emacs の処理時間が計算できます。もう少し細かく計測したい場合は、.emacs の先頭に
(defconst my-time-zero (current-time))
(defvar my-time-list nil)
(defun my-time-lag-calc (lag label)
(if (assoc label my-time-list)
(setcdr (assoc label my-time-list)
(- lag (cdr (assoc label my-time-list))))
(setq my-time-list (cons (cons label lag) my-time-list))))
(defun my-time-lag (label)
(let* ((now (current-time))
(min (- (car now) (car my-time-zero)))
(sec (- (car (cdr now)) (car (cdr my-time-zero))))
(msec (/ (- (car (cdr (cdr now)))
(car (cdr (cdr my-time-zero))))
1000))
(lag (+ (* 60000 min) (* 1000 sec) msec)))
(my-time-lag-calc lag label)))
(defun my-time-lag-print ()
(message (prin1-to-string
(sort my-time-list
(lambda (x y) (> (cdr x) (cdr y)))))))と書いて、計りたいところを (my-time-lag "好きなラベル") で囲って下さい。これで .emacs の最後に (add-hook 'after-init-hook (lambda () (my-time-lag-print)) t) ;; (2004/01/01 変更)と書いておくと、かかった時間順にソートして出力します。なお、個別関数の時間を計測する場合は elp.el: Emacs Lisp Profiler を使う方が良さそうです。
追記: かかった秒数に関する情報は *Message* バッファに出ますが、起動した状態で *Message* バッファに出しておきたいなら、最後にwindow-setup-hookに上記関数を入れて下さい（要するに(add-hook 'window-setup-hook (lambda () (my-time-lag)) t)と書く）。出力の最後の一行は見れると思います。この出力は emacs の操作を始めると消えますが、すぐ消したいなら、
(add-hook 'window-setup-hook
(lambda ()
(my-time-lag-orig)
(when (sit-for 1.0) (message nil))) ; 1秒あれば見れるよ
t)とすると良いと思います。ただ、.emacs.el に直接関係しない他の処理も入るので起動時間が少し延びて表示されるかもしれません。また、(setq inhibit-startup-message t)してないと、スタートアップ画面も遅れるので注意が必要です。
起動時間短縮の努力を始める前、自分の環境では .emacs.el 2,565行、バイトコンパイル済み、Pentium M 1.6G, Memory 1G, meadow 2 で 1.256 msec. くらいでした。meadow 1 に比べると meadow 2 は起動が遅いようです。この時点では、「使わないファイルは load しない」、「ネットワーク越しのファイルを見にいかない」というくらいしか注意していませんでした。
次に .emacs.el を少しダイエットして 2,009行 で 591 msec. ぐらいになりました。数百 msec. かかる migemo-init を消したり（さらに、SKK-JISYO.L の代わりにSKK-JISYO.ML を辞書に用いると migemo-init は 1/3 程度）、幾つか elisp package を読み込まないようにしました。まだ meadow 1 (220 msec.) との差は大きいです。起動時間のうち、scroll-bar-mode を消したり、menu-bar-mode を消したりするのが約 100 msec. 占めているようなので、これらを最初から消す方法がないか調べてみました。
色々調べて、meadow 2 の lisp/startup.el の設定と lisp/term/w32-win.el の (scroll-bar-mode nil) のコメントアウトを外して、meadow の再インストールしたら、起動時から menu-bar, scroll-bar, tooltip, tool-bar, blink-cursor をオフにすることができました。この変更の結果、起動時間は 500 msec となり（体感はそれ以上）だいぶ速くなってきました。（追記: tool-bar や tooltip などの幾つかの built-in な elisp は不要に思えるが、他の elisp との依存関係から除くのは難しいようです）
いつの間にか 611 msec. ぐらいまで遅くなっていたので、昔の version の meadow でコンパイルされた *.el を今の meadow でバイトコンパイルし直すと、530 msec. になりました（追記: これはどうも他の既に正しくバイトコンパイルされているファイルを、不適当にバイトコンパイルしてしまった副作用のようです）。ps-print.el が 5,000 行以上あって重いようだったので、後で notepad 経由の印刷にでも置き換えることにして消したら 490 msec. となりました。さらに、時間のかかっている shell-command は個人的には grep の時にしか使わないので、(eval-after-load "compile" '(require 'shell-command)) として、440 msec.、それでもまだ meadow1 (170 msec.) との差は大きい。portable dumper と unexec の違い (Meadow.dmp の読み込み) のためだろうか？
after-init-hook の末尾に (my-time-lag) を置いて、より正確なロード時間を測ってみたら、480 msec. となりました。30 msec. ぐらい、履歴のロードなどに時間をとられているようでさらに調べると、locate-library のライブラリチェックが 70 msec. ぐらいかかっているようだったので(load "physical-line" t)のように書くことにした。これで、401 msec.。
さらに、最初に読み込まれるロードパス？のうち、今はまず使わない BDF フォント関係のファイルをよそに移動したら、320 msec. になった。ついでに、mule-ucs も普段は使わないので、load-path 上に置かないようにしました。これで、260 msec. となった。不用意に沢山のディレクトリに load-path を通すと良くないのだろうか？いちいち下位ディレクトリ subdirs.el を探しに行くからか？これ以上は無理かな。これで meadow 1 (220 msec.) と起動時間は変わらない。ただし最初の frame が出るまでのタメのようなのがあるのは気になる。
Emacs のマニュアル（GNU Emacs Internals / Building Emacs の章）によると、ソース中で lisp/site-load.el とやらを作ってファイルを作り、その中にデフォルトで load する elisp などを書いておくと、それらを読み込んで dump してくれるらしい。より正確には、dump 時に読み込む lisp/loadup.el から lisp/site-load.el や lisp/site-init.el が読み込まれるようです。*Message* で確認できるのは (load "..." t) で読み込まれたファイルだけなので、(insert (prin1-to-string features)) （features は最後に読み込まれたものが先頭要素になっている）を *scratch* で評価して他に読み込まれているファイルを確認した後、試しに、ソースに含まれている以下のファイルを依存関係に注意して site-load.el に入れてみました。コンパイルするために、src/alloc.c の PDUMP_SUBR_DOC_SIZE と、src/makefile.meadow.w32-in と nt/makefile.def の PDUMP_OBJECT_ARRAY_SIZE を1〜2割ぐらい増やしておく必要がありました。* 印は入れておくと特に効果があると思われるもの。あまり入れすぎると、Meadow.dmp が肥大化して IO に時間がかかってしまうと思う。コメントアウトしてあるのはあまり効果がなかったもの。
;; (load "toolbar/tool-bar" t)
;; (load "tooltip" t)
;; (load "language/japan-util" t)
(load "international/encoded-kb" t)
(load "emacs-lisp/bytecomp" t) ;; *
(load "emacs-lisp/byte-opt" t) ;; * ただし、emacs-lisp/bytecomp に依存
(load "emacs-lisp/advice" t) ;; *
(load "emacs-lisp/regexp-opt") ;; *
(load "font-lock" t) ;; * ただし、regex-opt に依存
(load "time" t)
(load "minibuf-eldef" t)
(load "uniquify" t) ;; ただし、emacs-lisp/advice に依存
(load "paren" t)
(load "hl-line" t)
(load "windmove" t)
;; (load "international/mw32script" t)
(load "emacs-lisp/easymenu" t)
(load "emacs-lisp/easy-mmode" t)
;; (load "time-stamp" t)
;; (load "international/fontset" t)
;; (load "image-file" t)portable dumper はちゃんとこれらのファイルを読み込んで dump してくれたようです。また、外部 emacs lisp （例えば physical-line.el とか mcomplete.el）は site-load.el でなく、site-init.el で読み込むことで dump できました。ただし、結局読み込めないもの（minibuf-isearch.el, mic-paren.el, session.el など）もありました。Meadpw.dmp のサイズが1割強 (2199 KB -> 2565 KB) 大きくなったのが気になるが、load するファイルの半分ぐらいを dump に回したおかげで、1,951行、100 msec. になりました。体感でも確かにさらに少し速くなったように感じます。
最後に、起動時の最初の frame の出現位置とサイズが気になっていたので、これも変える事にしました。まず site-init.el に initial-frame-alist として default-frame-alist で指定しているのと同じ位置に emacs が立ち上がるように書き、初回起動時に左上の隅っこの方で立ち上がってズズズと後で動く気持ち悪さを無くしました。さらに、lisp/term/w32-win.el の "default" フォントを設定しているところを書き換えて、いつも使うフォントを書いたら、windows のリサイズを見なくて済むようになりました。（注意）個人で変更する設定を dump 時に読み込まれるこれらのファイルに書くのは、マニュアルによれば非推奨とのことです。
色々追加したりしていたら 130 msec. かかるようになっていたので、徹底した on demand 化をした。具体的には、migemo, tex-site (auctex), mode-info の3つ。migemo は論文を書いたりプログラム書くときには使わないし、tex-site は latex を書かない限り使わないし、mode-info は .emacs.el を書き換えるときしか使わないため。80 msec. と 100 msec. を切った。dump に入れてたファイルでも、こっちに回せるのがあるかも。after-init-hook でファイルを読み込んだりしてるパッケージはダメ（migemoはそうだけど、自分はキャッシュファイルとかを使っていないので）だけど。こんなコードを書いて 10 msec. でも速くしようという感覚はもはや病的かもしれない。require-safe は load-safe を参考に書いた「失敗してもこけない」require です。
;; migemo は日本語のファイルを初めて開いたときに読み込む
(defadvice find-file (after my-migemo-invoke activate)
(when (my-language-check "Japanese")
;; 参照: 日本語でない文書では isearch 時に migemo をオフにする
(when (require-safe 'migemo)
;; (require-safe 'kogiku)
(setq w32-pipe-read-delay 0))
(ad-deactivate 'find-file)
(ad-disable-advice 'find-file 'after 'my-migemo-invoke) ; 自分を消す
(ad-activate 'find-file)))
;; auctex は tex ファイルを初めて読んだときに読み込む
(defadvice find-file (before my-auctex-invoke activate)
(let ((file (ad-get-arg 0)))
(when (or (string-match "\.tex$" file) (string-match "\.bib$" file))
(require-safe 'tex-site)
(ad-deactivate 'find-file)
(ad-disable-advice 'find-file 'before 'my-auctex-invoke) ; 自分を消す
(ad-activate 'find-file)
)))
;; mode-info は .emacs.el を初めて読んだときに読み込む
(defadvice find-file (after my-mode-info-invoke activate)
(when (string= (expand-file-name (ad-get-arg 0))
(expand-file-name "~/.emacs.el"))
(when (require-safe 'mode-info)
(define-key global-map "\C-hf" 'mode-info-describe-function)
(define-key global-map "\C-hv" 'mode-info-describe-variable)
(define-key global-map "\M-." 'mode-info-find-tag))
(ad-deactivate 'find-file)
(ad-disable-advice 'find-file 'after 'my-mode-info-invoke) ; 自分を消す
(ad-activate 'find-file)))上に書いたログも含めて、この通りやってとんでもないことが起きても何の責任も取りませんが、
(when (locate-library "...") (load "...")) しないで単に (load "..." t) するか load-safe を使う。(cd "ローカルのダミーパス") 最後に (cd (getenv "HOME")) OR (cd "~/") と書くと起動が速くなることがあった。eval-after-load を使って on demand で読み込むようにする。例えば、ローカルの html ファイルしか表示しないのなら、w3m の設定は (load-path を通すところから) (eval-after-load "html-helper-mode" '(progn ...)) とする。もう体感は meadow 1 とあまり変わらない。ほぼ一瞬。Emacs は、一度立ち上げたらしばらく（時には何日も）立ち上げっぱなしだから、起動に時間がかかっても気にはならないけど、やはり素早く立ち上がると気持ちがいい。ランチャーを使っていて emacs を起動するまでの手続きが気にならないので、沢山沢山ファイルを開いて、気分的にもっさりしてうんざりしたときなど、サッと消してまた気分一新して立ち上げ直す、そういうことをしたくなる快適さだ。ブラボーだ。もうこれ以上スピード上げなくてもいい。
追記 (04/02/08): Meadow memo さんの PukiWiki の起動速度で紹介してもらった。load, require を autoload に置き換えると良いらしい。なるほど。しかし、そもそも自分の環境には既に autoload に置き換えられる load, require があまり無かった・・・。ロード後であることを想定した設定（キーバインディング等）などは、autoload で指定するファイルに load や require で読むファイルを指定しているのなら、eval-after-load でやったらダメかなーと思った。あと良く考えると autoload を提供しているパッケージを読み込むときはデフォルトの設定が autoload なことが多いので、それであまり無かったのかも。気がついた関数については、時間があるときに試してみよう。と思ったが、徹底した on demand をした結果、起動時には mic-paren.el しか .emacs.el からは読んでいないので、最適化の余地が無くなってしまった。
巷でよく見る .emacs.el の自動コンパイル の改良バージョンです。既存のもので何が問題かというと、三好さんの Emacs Evil Tips にもあるように、終了時に .emacs.el を自動バイトコンパイルしようとするとエラーを見逃すということです。かと言って、保存のたびにバイトコンパイルされるのも煩いので、その辺が起きないようにしたバージョンです。まずは M-s での手動コンパイル。
(defun my-emacs-lisp-byte-compile ()
(interactive)
(if (save-window-excursion (emacs-lisp-byte-compile))
(message "current buffer is successfully byte-compiled.")
(let (errs errl errc errp)
(with-current-buffer "*Compile-Log*"
(goto-char (point-max))
(forward-line -1)
;; *Compile-Log* がエラー箇所の情報を含まないときだけ
;; *Compiler Input* に基づきジャンプ
(cond ((re-search-forward "^.+:\\(.+\\):\\(.+\\):Error: \\(.+\\)$" nil t)
(setq errl (string-to-number (match-string 1))
errc (string-to-number (match-string 2))
errs (match-string 3)))
((re-search-forward "!! \\(.+\\)" nil t)
(setq errp (with-current-buffer " *Compiler Input*"
(point))
errs (match-string 1)))))
(cond (errp (unless (= errp (point-max)) (goto-char errp)))
(t (goto-line errl) (forward-char errc)))
(message errs))))M-s でバイトコンパイルしますが、バイトコンパイルの結果についてはミニバッファで報告します。どうせ *Compile-Log* なんか見なくてもどこでエラーが出てるかが分かることがほとんどでしょうから、バイトコンパイルに失敗したときは、*Compile-Log* からエラーメッセージだけ抜き出して出力しています。これを使って終了時に自動バイトコンパイルするコードは次のような感じ。
(add-hook 'kill-emacs-query-functions
(lambda ()
(if (file-newer-than-file-p "~/.emacs.el" "~/.emacs.elc")
(if (save-window-excursion (byte-compile-file "~/.emacs.el"))
t ;; 自動コンパイルに成功→ emacs を終了
(let (errs errl errc errp)
(switch-to-buffer (find-file "~/.emacs.el"))
(with-current-buffer "*Compile-Log*"
(goto-char (point-max))
(forward-line -1)
;; *Compile-Log* がエラー箇所の情報を含まないときだけ
;; *Compiler Input* に基づきジャンプ
(cond ((re-search-forward
"^.+:\\(.+\\):\\(.+\\):Error: \\(.+\\)$" nil t)
(setq errl (string-to-number (match-string 1))
errc (string-to-number (match-string 2))
errs (match-string 3)))
((re-search-forward "!! \\(.+\\)" nil t)
(setq errp (with-current-buffer " *Compiler Input*"
(point))
errs (match-string 1)))))
(cond (errp (unless (= errp (point-max)) (goto-char errp)))
(t (goto-line errl) (forward-char errc)))
(message errs)
nil)) ;; 自動コンパイルに失敗→ emacs を終了しない
t))) ;; ファイルが更新されていない→ emacs を終了これで終了時に .emacs.el を自動バイトコンパイルして失敗したときは、emacs を終了せずその旨ミニバッファに出力してくれるでしょう。
追記: この手のコードは、.emacs.el のできるだけ先頭に書いておくことをお勧めします。というのは、.emacs.el をいじった結果「バイトコンパイルは出来たけど起動したらエラーメッセージが出た」ということが時々あります。そういう場合、エラーの出たところで処理が止まってしまいます。そういうとき、エラーの出たところより前にこのコードを書いてあれば、変更した後でも M-x byte-compile-file などと面倒なコマンドを打たなくて済みます。
[追記 05/01/02] lisp/bytecomp.el のバージョンが新しければ"*Compile-Log*"の情報を、そうでなければ" *Compiler Input*"の情報を利用して、エラーが起きた行数に自動ジャンプするようにした。ただし、有意な情報が取れなかったときにはジャンプしない。
emacs に幾つかの機能を追加します。既存の emacs lisp パッケージでカバーできるものも含まれていますが、最低限の emacs lisp で必要な機能を実現することを目指してみました。
バッファ移動を簡単に，C-,（降順）とC-.（昇順）で出来るようにします。バッファの数が多くなりすぎて目的のバッファがどこにあるのか分からなかったときのために、バッファリスト表示するようにしました。バッファをそんなに開かない人向け。emacs 21, meadow 2 専用。
(defvar my-ignore-blst ; 移動の際に無視するバッファのリスト
'("*Help*" "*Compile-Log*" "*Mew completions*" "*Completions*"
"*Shell Command Output*" "*Apropos*" "*Buffer List*"))
(defvar my-visible-blst nil) ; 移動開始時の buffer list を保存
(defvar my-bslen 15) ; buffer list 中の buffer name の最大長
(defvar my-blist-display-time 2) ; buffer list の表示時間
(defface my-cbface ; buffer list 中で current buffer を示す face
'((t (:foreground "wheat" :underline t))) nil)
(defun my-visible-buffers (blst)
(if (eq blst nil) '()
(let ((bufn (buffer-name (car blst))))
(if (or (= (aref bufn 0) ? ) (member bufn my-ignore-blst))
;; ミニバッファと無視するバッファには移動しない
(my-visible-buffers (cdr blst))
(cons (car blst) (my-visible-buffers (cdr blst)))))))
(defun my-show-buffer-list (prompt spliter)
(let* ((len (string-width prompt))
(str (mapconcat
(lambda (buf)
(let ((bs (copy-sequence (buffer-name buf))))
(when (> (string-width bs) my-bslen) ;; 切り詰め
(setq bs (concat (substring bs 0 (- my-bslen 2)) "..")))
(setq len (+ len (string-width (concat bs spliter))))
(when (eq buf (current-buffer)) ;; 現在のバッファは強調表示
(put-text-property 0 (length bs) 'face 'my-cbface bs))
(cond ((>= len (frame-width)) ;; frame 幅で適宜改行
(setq len (+ (string-width (concat prompt bs spliter))))
(concat "\n" (make-string (string-width prompt) ? ) bs))
(t bs))))
my-visible-blst spliter)))
(let (message-log-max)
(message "%s" (concat prompt str))
(when (sit-for my-blist-display-time) (message nil)))))
(defun my-operate-buffer (pos)
(unless (window-minibuffer-p (selected-window));; ミニバッファ以外で
(unless (eq last-command 'my-operate-buffer)
;; 直前にバッファを切り替えてなければバッファリストを更新
(setq my-visible-blst (my-visible-buffers (buffer-list))))
(let* ((blst (if pos my-visible-blst (reverse my-visible-blst))))
(switch-to-buffer (or (cadr (memq (current-buffer) blst)) (car blst))))
(my-show-buffer-list (if pos "[-->] " "[<--] ") (if pos " > " " < " )))
(setq this-command 'my-operate-buffer))
(global-set-key [?\C-,] (lambda () (interactive) (my-operate-buffer nil)))
(global-set-key [?\C-.] (lambda () (interactive) (my-operate-buffer t)))emacs 20 では、「message 内部で使われる format がテキスト属性を保存しないので、Echo エリアに出力しても色がつかない」・「Echoエリアに複数行にまたがる文字列を表示できない」ため、使えません。
追記: howm を使い始めて、バッファ名に%があるとき message がエラーを吐くことに気づいたので、一部修正。
同じようなコードは他にも色々あるようです。例えば、pc-bufsw.el や swbuff.el など。
上記のコードを少し改造して、バッファを指定した移動機能と簡単絞り込み機能とを追加したものは以下。C-@ で、バッファリストの後に出る "Specify Buffer ID: " というプロンプトに続き、バッファ番号を指定すれば移動できます。C-; で、バッファリストの後に出る "Buffer-name regexp: " というプロンプトに続き、移動したいバッファが含む文字列をタイプするとその文字列を含むバッファのみに移動するようになります。入力が終わったら、C-. または C-, を押すと、移動を再開します。さらに絞込みをしたいときは、C-; または RET を押します。空文字列で RET するか、候補が一つに絞れると絞込みを終了します。あくまで補助用の絞込み機能なので、iswitchb のようにインクリメンタルには絞り込みません。先頭一致だけで良いなら、(icomplete や mcomplete などのパッケージを読み込んで) (= my-op-mode 4) の body 部で read-string の代わりに read-buffer を使えば良いです。部分一致でインクリメンタルに絞り込みたいなら最初から iswitchb を使った方が良いでしょう。
(defvar my-ignore-blst ; 移動の際に無視するバッファのリスト
'("*Help*" "*Mew completions*" "*Completions*" "*Shell Command Output*"
"*Buffer List*"))
(defvar my-vblst nil) ; 移動開始時の buffer list を保存
(defvar my-bslen 15) ; buffer list 中の buffer name の最長値
(defvar my-blst-display-time 2) ; buffer list の表示時間
(defface my-cbface ; buffer list 中の current buffer を示す face
'((t (:foreground "red" :underline t))) nil)
(defvar my-op-mode) ; 自動設定される変数 (1 前移動 2 次移動 3 ID移動 4 フィルタ)
(defvar my-spliter-alist ; バッファ表示中のバッファ間のスプリッタ
'((1 . " < ") (2 . " > ") (3 . " ") (4 . " / ")))
(defvar my-prompt-alist ; バッファ表示中のプロンプト
'((1 . "[<<-] ") (2 . "[->>] ") (3 . "") (4 . "")))
(defun my-visible-buffers (blst &optional reg)
(if (eq blst nil) '()
(let ((bufn (buffer-name (car blst))))
(if (or (= (aref bufn 0) ? ) ; ミニバッファと
(not (string-match (or reg "") bufn)) ; reg を含まないバッファと
(member bufn my-ignore-blst)) ; 無視するバッファには移動しない
(my-visible-buffers (cdr blst) reg)
(cons (car blst) (my-visible-buffers (cdr blst) reg))))))
(defun my-buf-id (buf) (format "%s) " (length (memq buf (reverse my-vblst)))))
(defun my-show-buffer-list ()
(let* ((prompt (cdr (assq my-op-mode my-prompt-alist)))
(spliter (cdr (assq my-op-mode my-spliter-alist)))
(len (string-width prompt))
(str (mapconcat
(lambda (buf)
(let ((bs (copy-sequence (buffer-name buf))))
(if (> (string-width bs) my-bslen) ; 切り詰め
(setq bs (concat (substring bs 0 (- my-bslen 2)) "..")))
(setq len (+ len (string-width (concat bs spliter))))
(when (eq buf (current-buffer)) ; 表示中のバッファは強調表示
(put-text-property 0 (length bs) 'face 'my-cbface bs))
(cond ((> len (frame-width)) ;; frame 幅で適宜改行
(setq len (+ (string-width (concat prompt bs spliter))))
(concat "\n" (make-string (string-width prompt) ? ) bs))
(t (concat (and (= my-op-mode 3) (my-buf-id buf)) bs))))) ; ID
my-vblst spliter)))
(cond ((<= my-op-mode 2) ; 単純移動
(let (message-log-max)
(message "%s%s" prompt str))
(if (sit-for my-blst-display-time) (message nil))) ; 表示を消す
((= my-op-mode 3) ; バッファの ID を指定して移動
(let* ((id-str (read-string (concat str "\nSpecify Buffer ID: ")))
(id (string-to-number id-str)))
(if (and (>= id 1) (<= id (length my-vblst))) ;; 移動できる ID なら
(switch-to-buffer (nth (1- id) my-vblst)) ;; 移動する
;; 空文字列をIDに指定して、さらにIDを指定しようとしていたら終了
(unless (and (eq my-op-mode 3) (string= id-str "")) ; (*)
(my-show-buffer-list))))) ; さもなければ my-op-mode で再処理
((= my-op-mode 4) ; バッファ名を正規表現でフィルタ
(let* ((reg (read-string (concat str "\nBuffer-name regexp: "))))
;; フィルタで絞込みをかけて移動候補のバッファを再設定
(setq my-vblst (or (my-visible-buffers my-vblst reg) my-vblst))
;; 空文字列で絞込みしていなければ、更新された移動候補の先頭に移動
(when (not (string= reg "")) (switch-to-buffer (car my-vblst)))
;; 空文字列で絞込みして、さらに絞込みをしようとしていたら終了
(when (or (not (eq my-op-mode 4)) (not (string= reg ""))) ; (*)
(my-show-buffer-list)))) ; さもなければ my-op-mode に従い再処理
)))
;; バッファの順序が乱れるのを防止
(defun my-rotate-buffer (cbuf slst)
;; bury-bufferを使って、カレントバッファが先頭に来るように回転
(cond ((eq cbuf (car slst)) t)
(t (bury-buffer (car slst))
(my-rotate-buffer cbuf (cdr slst)))))
(defun my-sort-buffer-by (x y) ; 特殊バッファ→通常バッファでファイル名順
(if (and (buffer-file-name x) (buffer-file-name y))
(string< (buffer-file-name x) (buffer-file-name y))
(string< (buffer-name x) (buffer-name y))))
(defun my-sort-buffer ()
"Sort buffer list by name"
(interactive)
(let ((cbuf (current-buffer))
(slst (sort (buffer-list) 'my-sort-buffer-by)))
(message (prin1-to-string slst))
(my-rotate-buffer cbuf (append (cdr (memq cbuf slst)) slst))))
(defun my-operate-buffer (mode)
(setq my-op-mode mode)
;; my-show-buffer-list 中の read-string を潰す↓の exit-minibuffer より先に
;; ↑で my-op-mode に mode を指定しておく (*) 時に有効
(when (window-minibuffer-p (selected-window)) (exit-minibuffer))
(unless (eq last-command 'my-operate-buffer) ; バッファリスト初期化
(my-sort-buffer)
(setq my-vblst (my-visible-buffers (buffer-list))))
(when (<= my-op-mode 2)
(let* ((blst (if (= my-op-mode 2) my-vblst (reverse my-vblst))))
(switch-to-buffer (or (cadr (memq (current-buffer) blst)) (car blst)))))
(my-show-buffer-list)
(setq this-command 'my-operate-buffer))
(defun my-sellect-visible-buffers () (interactive) (my-operate-buffer 3))
(defun my-filter-visible-buffers () (interactive) (my-operate-buffer 4))
(global-set-key [?\C-,] (lambda () (interactive) (my-operate-buffer 1)))
(global-set-key [?\C-.] (lambda () (interactive) (my-operate-buffer 2)))
(global-set-key [?\C-@] 'my-sellect-visible-buffers)
(global-set-key [?\C-\;] 'my-filter-visible-buffers)[追記: 08/08/07] C++ をまた書くようになって、同名のヘッダファイルとの間で移動する機会が増えたので、バッファリストの順序を保持するよう昔のコードを流用。
おまけ: kill-buffer で変なバッファに行かないようにする。（昔のものはバグがあることが分かったので、上の最新のバッファ移動の elisp と組み合わせて使ってください）
(defun my-kill-buffer (buf)
(interactive "bKill buffer: ")
(let* ((blst (my-visible-buffers (buffer-list)))
(nbuf (or (car (cdr (memq (get-buffer buf) blst)))
(and (consp (cdr blst)) (car blst))
"*scratch*"))) ;; 最後のバッファなら *scratch* に移動
(kill-buffer buf)
(unless (memq (get-buffer buf) blst) ;; バッファが消えなければ移動しない
(switch-to-buffer (get-buffer-create nbuf)))))*scratch* を消さないようにしているなら、以下でOK。
(defun my-kill-buffer (buf)
(interactive "bKill buffer: ")
(let* ((blst (my-visible-buffers (buffer-list)))
(nbuf (or (car (cdr (memq (get-buffer buf) blst))) (car blst))))
(kill-buffer buf)
(unless (memq (get-buffer buf) blst) ;; バッファが消えなければ移動しない
(switch-to-buffer (get-buffer-create nbuf)))))[2004/01/03] マルチバイト文字でバッファを作ると改行幅計算がおかしくなるので length を string-width に直した。
LaTeX で論文などを書いていて、コメントアウトを大量にしたりしたときに、isearch でコメント行をスキップしたくなるときがあります。また逆に、プログラムを書いているときに、コメント行だけを検索したくなるときがあります。それらを実現する emacs lisp です。
;; comment 行を skip する search-forward
(defadvice search-forward (around my-comment-skip disable)
(while (and (integerp ad-do-it)
(not (string= (ad-get-arg 0) ""))
(nth 4 (parse-partial-sexp (point-min) ad-return-value)))))
;; comment 行以外を skip する search-forward
(defadvice search-forward (around my-comment-only disable)
(while (and (integerp ad-do-it)
(not (string= (ad-get-arg 0) ""))
(not (nth 4 (parse-partial-sexp (point-min) ad-return-value))))))
(fset 'isearch-forward-comment-only 'isearch-forward)
(fset 'isearch-forward-comment-skip 'isearch-forward)
;; isearch-forward が内部で使っている search-forward を、
;; isearch-forward-comment-skip ではコメント行を無視するように
;; isearch-forward-comment-only ではコメント行以外を無視するように変更
(defadvice isearch-forward-comment-skip (before my-ad-activate activate)
(ad-enable-advice 'search-forward 'around 'my-comment-skip)
(ad-activate 'search-forward))
(defadvice isearch-forward-comment-only (before my-ad-activate activate)
(ad-enable-advice 'search-forward 'around 'my-comment-only)
(ad-activate 'search-forward))
(add-hook 'isearch-mode-end-hook
(lambda ()
(ad-deactivate 'search-forward)
(ad-disable-advice 'search-forward 'around 'my-comment-skip)
(ad-disable-advice 'search-forward 'around 'my-comment-only)
(ad-activate 'search-forward)))isearch-forward （より具体的には、isearch-search）内で使われる search-forward を wrap して実現しています。使うときは、M-x isearch-forward-comment-skip でコメント行を無視した isearch が、M-x isearch-forward-comment-only でコメント行以外を無視した isearch ができます。一旦上記関数を呼び出したら、後は isearch-forward（要するに通常のキーバインディングであれば C-s）で isearch できます。
追記 (04/02/03): すいません、以前のコードは、migemo じゃない isearch を使っている時に確実に無限ループするコードだったようなので、上記に直してください。どうも、普通の isearch だと最初に呼ばれる search-forward には空文字列が渡されるようです。「日本語でない文書では isearch 時に migemo をオフにする」を作ったので気がつきました。
上記の関数は、（最新版の）migemo だとうまく行きません。というのは、 isearch は search-foward で文字列を探索している（ハイライトする文字列も）のに対し、migemo は search-forward-regexp（ハイライトする文字列は re-search-forward） で探索しているためです。従って、上記のコードに加えて、re-search-forward, search-forward-regexp についても同様の advice 定義を行い、search-forward と同じように ad-disable-advice, ad-activate すると、migemo のときにも探索対象の文字列だけハイライトするようにできます。isearch, migemo 両方の場合に対応したコードは以下の通り。
;; 文字列探索し、コメント行かどうかをチェックする関数
(defun my-search-comment (point str flag)
(and (integerp point)
(not (string= str "")) ;; ↓トリック的なコード
(if (nth 4 (parse-partial-sexp (point-min) point)) flag (not flag))))
;; コメント行を無視する (re-)search-forward(-regexp)
(defadvice search-forward (around my-comment-skip disable)
(while (my-search-comment ad-do-it (ad-get-arg 0) t)))
(defadvice search-forward-regexp (around my-comment-skip disable)
(while (my-search-comment ad-do-it (ad-get-arg 0) t)))
(defadvice re-search-forward (around my-comment-skip disable)
(while (my-search-comment ad-do-it (ad-get-arg 0) t)))
;; コメント行以外を無視する (re-)search-forward(-regexp)
(defadvice search-forward (around my-comment-only disable)
(while (my-search-comment ad-do-it (ad-get-arg 0) nil)))
(defadvice search-forward-regexp (around my-comment-only disable)
(while (my-search-comment ad-do-it (ad-get-arg 0) nil)))
(defadvice re-search-forward (around my-comment-only disable)
(while (my-search-comment ad-do-it (ad-get-arg 0) nil)))
(fset 'isearch-forward-comment-only 'isearch-forward)
(fset 'isearch-forward-comment-skip 'isearch-forward)
;; isearch-forward (migemo-forward) が内部で使っている search-forward
;; (search-forward-regexp, re-search-forward) を
;; isearch-forward-comment-skip ではコメント行を無視するように
;; isearch-forward-comment-only ではコメント行以外を無視するように変更
(defadvice isearch-forward-comment-skip (before my-ad-activate activate)
(mapcar
(lambda (x) (ad-enable-advice x 'around 'my-comment-skip) (ad-activate x))
(list 'search-forward 'search-forward-regexp 're-search-forward)))
(defadvice isearch-forward-comment-only (before my-ad-activate activate)
(mapcar
(lambda (x) (ad-enable-advice x 'around 'my-comment-only) (ad-activate x))
(list 'search-forward 'search-forward-regexp 're-search-forward)))
(add-hook 'isearch-mode-end-hook
(lambda ()
(mapcar
(lambda (x)
(ad-deactivate x)
(ad-disable-advice x 'around 'my-comment-skip)
(ad-disable-advice x 'around 'my-comment-only)
(ad-activate x))
(list 'search-forward 'search-forward-regexp 're-search-forward))))遊びで作った emacs lisp だったが，実用しなければいけない状況になったので、toggle できるよう作りかえたものは以下．M-x isearch-comment-toggleで，通常検索 (OFF)→ コメント行を無視して検索 (CS) → コメント行のみ検索と切り替えられます．
;; 文字列探索し、コメント行かどうかをチェックする関数
(defun search-comment (point str flag)
(and (integerp point)
(not (string= str "")) ;; ↓トリック的なコード
(if (nth 4 (parse-partial-sexp (point-min) point)) flag (not flag))))
(defvar isearch-sense-comment-status "OFF") ; 初期状態
(defun isearch-comment-toggle ()
;; off (OFF) -> comment skip (CS) -> comment only (CO) -> off; (loop)
(interactive)
(isearch-sense-comment-off)
(cond
((string= isearch-sense-comment-status "CS") ; comment only -> comment skip
(isearch-comment-mode "CO"))
((string= isearch-sense-comment-status "CO") ; comment skip -> nil
(isearch-comment-mode "OFF"))
(t (isearch-comment-mode "CS"))))
(defun isearch-comment-mode (mode)
(message (concat "isearch sense comment status is changed to " mode ))
(unless (string= mode "OFF")
(mapcar
(lambda (x)
(ad-enable-advice x 'around
(if (string= mode "CO") 'comment-only 'comment-skip))
(ad-activate x))
(list 'search-forward 'search-forward-regexp 're-search-forward)))
(setq isearch-sense-comment-status mode))
(defadvice isearch-message-prefix (after comment-status activate)
"adviced by comment-skip/only."
(unless (string= isearch-sense-comment-status "OFF")
(setq ad-return-value
(concat "[" isearch-sense-comment-status "] " ad-return-value))))
;; コメント行を無視する (re-)search-forward(-regexp)
(defadvice search-forward (around comment-skip disable)
(while (search-comment ad-do-it (ad-get-arg 0) t)))
(defadvice search-forward-regexp (around comment-skip disable)
(while (search-comment ad-do-it (ad-get-arg 0) t)))
(defadvice re-search-forward (around comment-skip disable)
(while (search-comment ad-do-it (ad-get-arg 0) t)))
;; コメント行以外を無視する (re-)search-forward(-regexp)
(defadvice search-forward (around comment-only disable)
(while (search-comment ad-do-it (ad-get-arg 0) nil)))
(defadvice search-forward-regexp (around comment-only disable)
(while (search-comment ad-do-it (ad-get-arg 0) nil)))
(defadvice re-search-forward (around comment-only disable)
(while (search-comment ad-do-it (ad-get-arg 0) nil)))
(defun isearch-sense-comment-off ()
(mapcar
(lambda (x)
(ad-deactivate x)
(ad-disable-advice x 'around 'comment-skip)
(ad-disable-advice x 'around 'comment-only)
(ad-activate x))
(list 'search-forward 'search-forward-regexp 're-search-forward)))
(add-hook 'isearch-mode-end-hook
(lambda ()
(unless isearch-sense-comment-status
(isearch-sense-comment-off))))[追記: 04/11/14] migemo に対応したコードに更新して、ついでに少しだけ短くした。face を調べる方がシンプルかもしれない。短くし過ぎて my-search-comment が良く分からなくなってしまった。
[追記: 07/10/23] toggle できるようにした．
いやなブログ: JavaScript でインクリメンタル grep 検索というのを見つけて、emacs でも isearch のハイライトする関数 (lazy-highlight) に advice するだけで実現できそうだったのでちょっとやってみたら、割とカンタンにそれっぽいものができた。lazy-highlight を使わなかったが使えばもっと楽に書けるのだろうか。
(defvar my-igrep-buffer "*Incremental Grep*") ; grep 結果を表示する window の名前
(defvar my-igrep-window-height 10) ; grep 結果を表示する window の高さ
(defvar my-igrep-window-offset 3) ; grep 結果中の、現在行の表示位置
(defvar my-igrep-with-color t) ;マッチした文字列に色をつけて表示
(defvar my-igrep-mark-str "=>") ; mark
(defvar my-igrep-min-length 3) ; grep する最短文字数
(defvar my-igrep-delay 0) ; grep し始めるまでの delay
(defvar my-igrep-light-mode nil) ; migemo （日本語検索）を grep に使うか
(defvar my-igrep-enable-p t) ; igrep オン・オフの初期設定
(defface my-igface '((t (:background "paleturquoise"))) nil) ; 色
(defvar my-igrep-match 0)
(defvar my-igrep-overlay nil)
(defvar my-igrep-buffer-limit 1000000) ; buffer-size の制限 for T. T. & Y. M.
(defvar my-igrep-window-configuration nil)
(defadvice isearch-mode (before my-igrep activate)
(when my-igrep-enable-p
(get-buffer-create my-igrep-buffer)
(with-current-buffer my-igrep-buffer
(make-local-variable 'window-min-height)
(setq window-min-height 2
truncate-lines t)))) ; *1
(add-hook 'isearch-mode-end-hook
(lambda ()
(my-igrep-window-cleanup)
(when my-igrep-enable-p (kill-buffer my-igrep-buffer))))
(defadvice isearch-update (after my-igrep activate)
(if (and
my-igrep-enable-p
(<= (buffer-size) my-igrep-buffer-limit)
(>= (length isearch-string) my-igrep-min-length))
(my-igrep-display)
(my-igrep-window-cleanup)))
(defun my-igrep-toggle-grep-enable ()
(interactive)
(message (if (setq my-igrep-enable-p (not my-igrep-enable-p)) "t" "nil")))
(defun my-igrep-search (&optional end)
(if (and my-igrep-light-mode (featurep 'migemo) migemo-isearch-enable-p)
(re-search-forward (migemo-get-pattern isearch-string) end t)
(search-forward isearch-string end t)))
(defun my-igrep-colorize (str beg end pos)
(put-text-property (- (match-beginning 0) beg) pos 'face 'my-igface str)
(if (my-igrep-search end) (my-igrep-colorize str beg end (- (point) beg)) str))
(defun my-igrep-window-setup () ;; 検索 window の setup
(set-window-buffer
(cond ((>= (- (window-height) my-igrep-window-height) window-min-height)
(setq my-igrep-window-configuration (current-window-configuration))
(split-window (selected-window) ; 分割可能な window なら分割して表示
(- (window-height) (1+ my-igrep-window-height))))
(t (next-window)))
(get-buffer my-igrep-buffer)))
(defun my-igrep-window-cleanup () ;; 検索 window の cleanup
(when (window-configuration-p my-igrep-window-configuration)
(set-window-configuration my-igrep-window-configuration)
(setq my-igrep-window-configuration nil)))
(defun my-igrep-display ()
(let ((clinen (count-lines (point-min) (point))))
(when (sit-for my-igrep-delay) ; (or (= my-igrep-delay 0)
(save-excursion
(goto-char (point-min))
(unless (memq this-command ; 検索文字列が変更されたときのみ再検索
(list 'isearch-repeat-forward 'isearch-repeat-backward))
(setq my-igrep-match 0)
(with-current-buffer my-igrep-buffer (erase-buffer))
(let ((linen 1)
(ppos (point)))
(while (my-igrep-search) ; マッチした行だけ処理
(setq linen (+ linen (1- (count-lines ppos (setq ppos (point))))))
(let* ((beg (save-excursion (progn (beginning-of-line) (point))))
(end (save-excursion (progn (end-of-line) (point))))
(str (buffer-substring beg end))) ;-no-properties
(setq my-igrep-match (1+ my-igrep-match))
(when my-igrep-with-color
(setq str (my-igrep-colorize str beg end (- (point) beg))))
(with-current-buffer my-igrep-buffer
(insert (concat (format "%7d: " linen)) str "\n"))))))
(cond ((= my-igrep-match 0) (my-igrep-window-cleanup))
((not (window-configuration-p my-igrep-window-configuration))
(my-igrep-window-setup)))
(when (and (> my-igrep-match 0) my-igrep-window-configuration)
(save-selected-window
(select-window (get-buffer-window my-igrep-buffer))
(with-current-buffer my-igrep-buffer
(goto-char (point-max))
(let* ((alen (length my-igrep-mark-str))
(beg (re-search-backward (format "^ +%d:" clinen) nil t))
(end (save-excursion (end-of-line) (point)))
(alinen (count-lines (point-min) (point))))
(when (and beg (> my-igrep-match 0))
(setq beg (1+ beg)) ; *2
(if my-igrep-overlay
(move-overlay my-igrep-overlay beg (+ beg alen))
(setq my-igrep-overlay (make-overlay beg (+ beg alen))))
(overlay-put my-igrep-overlay 'invisible t) ; *3
(overlay-put my-igrep-overlay 'before-string my-igrep-mark-str)
(when my-igrep-window-configuration ;; リサイズ
(enlarge-window
(1+ (- (if (> my-igrep-match (window-height))
(min my-igrep-window-height my-igrep-match)
(max window-min-height my-igrep-match))
(window-height)))))
(when (> my-igrep-match (window-height))
(recenter (- my-igrep-window-offset 1)))
(setq mode-line-buffer-identification
`("%b" ,(format " - %d:%d matches" alinen my-igrep-match))))
(force-mode-line-update)))))))))Meadow 2.20 で動作確認したが、Meadow 2.01, 2.10 や Meadow 1.15 でも動いた。ただ、occur したいんだったら最初から
(defadvice isearch-update (after my-isearch-grep activate)
(unless (string= isearch-string "")
(occur isearch-string)))とすればよいだけのことじゃないか・・・。でも、開いた後に、そのときの画面構成を保ったまま occur の window に移れないようだ。color-moccur もこれではうまく動いてくれない。
[04/12/31] 日本語検索時にも色がつくように直した。一行に複数の候補があるときの振る舞いを改善した。一行だけ見せるようにした。なかなか便利な気がしてきた。
[05/01/13-14] 同じ文字列を検索するときに無駄な検索をしないように検索バッファをフラッシュしないようにした。それと関連して、yank-pop-summary.el のコードを参考に、overlay で矢印を出すことに。これでいいのだろうか。あと、色付けのときに既に検索した文字列をもう一度検索しないようにした。
[05/01/16] コードを全体的に縮めた。emacs 21 以降だとマッチする行が含む character 数が約500を超えると、その前後で overlay の invisible (*3) が固まるという現象が発生した。ちょっと調べたところ、[mule-ja] Re: Emacs21: invisible property at beginning of line に書いてある行頭の invisible プロパティに対する xdisp.c へのパッチと干渉していることが分かった。バグだろうか。const int MAX_NEWLINE_DISTANCE の数値を上げると固まらないようにできるが、そのためだけにコンパイルし直すのもどうかと。簡単には、*1 を nil にするか、*2 のように先頭以外から overlay しないようにすれば良いことが分かったので、*2 で直しておいた。yank-pop-summary.el を Emacs 21 でコピペして評価して使おうとすると固まっていたのもどうも同じ理由のような気がした。kill-ring の要素に、長い文字列があるとき固まるようだ。一字ごとに grep にする代わりに、次の入力がすぐ来たら grep しないようにした。my-igrep-delay で待ち時間を指定する。
[05/01/17] さらに拡張。migemo 検索も grep 対象に入れるかどうか（my-igrep-light-mode で指定）、igrep をトグルするコマンド（M-x my-igrep-toggle-grep-enable）、window-height より検索対象が少ないときにはリサイズする機能などをつけた。
[05/01/27] 検索一致数に合わせてリサイズするようにした。役に立つかどうかはともかく、クールになったかも。JavaScript でインクリメンタル grep 検索の雰囲気にやや近づいたか。110 行になってしまった。もう petit じゃないや。残念。何とか後で短くしよう。
[09/08/07] 学会で会った T 研の後輩の Y. M. 君から数百Mのファイルを開いて isearch すると emacs が死ぬのでなんとかならないかと言われたので、検索するファイルの上限を指定できるようにした。手元の 32-bit emacs で開けるファイルサイズの上限に近いファイル (112MB) で試した限り問題無し．
[05/01/27] 以下は TODO（プライオリティの高い順）:
migemo では、辞書で定義される単語区切りを超えて検索を行うために、連文節検索という機能があります。例えば、「明日は金沢で買い物」は、単語の区切りで大文字に打ち変えて、「asitaHaKanazawaDeKaimono」とタイプすれば検索できます。しかしながら、辞書の単語定義に精通していても、ついつい単語の頭を大文字にすることを忘れ、検索にヒットしないことに首をかしげて一文字戻って大文字に打ち直すということを良くやります。そこで、検索にヒットしないときは自動で次文節に切り替える自動連文節検索を実装してみました。
与えられたローマ字文字列から、単語の先頭を正確に推定することはできませんが、インクリメンタルに検索している場合、検索にヒットしないときだけ大文字化すれば、経験上ほとんどのケースは救える上に、検索できていた単語が検索できなくなるというような副作用もありません。
(defun my-upcase-at-pos (str pos) ; upcase str at a given pos
(store-substring (copy-sequence str) pos (upcase (aref str pos))))
(defun my-gen-renstr (str &optional index) ; 次単語の先頭を大文字化
(setq index (or index (1- (length str)))) ; 検索文字列の末尾から
(cond ((= index 0) ; 1-depth fallback
(cond ((let ((case-fold-search nil)) (string-match "[^a-z]$" str)) str)
(t (my-gen-renstr (my-upcase-at-pos str (1- (length str)))))))
((and ; 文節の先頭となり得る位置で
(let ((case-fold-search nil))
(string-match "^[a-z]" (substring str index)))
(string-match "^[aiueon]\\(?:[a-mo-z].*\\|n[aiueo].*\\|n\\)$"
(substring str (1- index))))
(save-excursion ; 検索が成功するかどうか検査
(goto-char (point-min))
(migemo-forward (my-upcase-at-pos str index) nil t)))
(my-upcase-at-pos str index))
(t (my-gen-renstr str (1- index))))) ; try backward
(defadvice isearch-update (after my-migemo-auto-ren activate)
(when (and (featurep 'migemo) migemo-isearch-enable-p ; migemo が on で，
(eq this-command 'isearch-printing-char) ; 検索文字列を伸ばして
(not isearch-success) ; 検索に失敗し，
(save-excursion ; 残りのバッファを検索しても検索文字列がない場合
(not (funcall
(if isearch-forward 'migemo-backward 'migemo-forward)
isearch-string nil t))))
;; migemo で isearch に失敗したら連文節検索を試みる
(let ((renstr (my-gen-renstr isearch-string)))
(when renstr
(setq isearch-string renstr
isearch-message isearch-string)
(goto-char isearch-opoint) ; 再検索
(isearch-search)))))これで、「asitahakanazawadekaimono」とタイプするだけで、「明日は金沢で買い物」を検索できます。思ったより便利です。普通に単語を打つときと同様、検索にヒットする単語まで移動してくれます。コードは相変わらず洗練されていないので、もうちょっと直します。内部でかな漢字変換を呼べばもう少し賢く推定できるだろうけど、一バッファのインクリメンタル検索ならこれぐらいで十分では無かろうか。
[仕様] ascii が混じるときに適切に大文字化できない。他にも時々挙動不審。気が向いたら直そう。meadow memo さんに紹介してもらって、isearch-update の advice の直し忘れに気づいたので訂正。
[06/10/14 追記] 自動連文節変換は文節の先頭位置に曖昧性があるため、本質的に検索漏れの可能性がある。鉄道の日きっぷで電車で移動中に時間ができたので、ちょっといじってみた。具体的には、1-depth の fallback を行うようにした。検索文字列を追加していけば、実用的には大体まともに動くようになったかもしれない。例えば、
;; 東京都京都
;; 東京と京都には
;; 東京と今日と雨は
;; 東京ときょうと雨がとあって、"toukyoutok" とタイプすると、「東京都京都」に"toukyoutoK"でマッチし、続いて"toukyoutoKyouton"だと、「東京と京都には」に"toukyouToKyoutoN"でマッチ、"toukyoutoKyoutoa"とタイプすると、「東京ときょうと雨は」に"toukyouToKyoutoA"でマッチ、"toukyouToKyoutoAmeg"とタイプすると「東京と今日と雨が」に"toukyouToKyouToAmeG"でマッチする。
以前は送り仮名に曖昧性がある場合、例えば「相変わらず」のような場合は、"aikawa"で"相変"にマッチするため"aikawar"で検索できなかった（"aikawaR"になる）が、文節の先頭位置を全探索するようにしたおかげで検索できるようになった。また、連文節の位置の判定のときに case-fold-search を適切に設定するようにした。ただし、二カ所以上文節位置が違う同じ読みの文字列があるときは検索漏れがある（例えば、「東京都京都」と「東京と今日と雨は」だけを含むバッファで検索してみると分かる）。
[06/10/15 追記] 今日も電車の中で時間があったので、全探索するコードを書いてみました。
;; 文字列に対する全連文節候補（文節？の先頭可能位置の巾集合）を、接頭辞ごと
;; にまとめあげる（インクリメンタル検索なのでこれで探索範囲を枝狩りできる）
;; なお、高速化のため以下の順で連文節候補の探索が行われるようにする
;; 1) 文字列末尾により近い文節の先頭可能位置を含む
;; 2) 文節数のより少ない連文節候補
(defun my-gen-renpos-trie (all)
(if (null all) '()
(append
(my-gen-renpos-trie (cdr all))
(list (cons (car all) (my-gen-renpos-trie (cdr all)))))))
;; 文節の先頭となり得る位置の数え上げ
(defun my-ren-pos-list (str index)
(cond ((= index (length str)) '())
((string-match "^[aiueon]\\(?:[a-mo-z].*\\|n[aiueo].*\\|n\\)$"
(substring str (1- index)))
(cons index (my-ren-pos-list str (1+ index))))
(t (my-ren-pos-list str (1+ index)))))
;; 全連文節候補をできるだけ効率良く再検索
(defun my-try-rensearch (str ptrie fallback)
(if (null (car ptrie)) ; 検索失敗
(if (null fallback) ;; fallback スタックが空でなければ fallback
nil
(my-try-rensearch (caar fallback) (cdar fallback) (cdr fallback)))
(let* ((renstr
(store-substring
(copy-sequence str) (caar ptrie) (upcase (aref str (caar ptrie)))))
(renp (or (caar (cdar ptrie)) (length str)))
(renpstr (substring renstr 0 renp)))
(if (save-excursion ; 接頭辞検索が成功するかどうか
(goto-char (point-min))
(migemo-forward renpstr nil t))
(if (string= renstr renpstr)
renstr ;; 検索終了
;; 成功すれば fallback スタックに積んで探索文字列を伸ばす
(my-try-rensearch
renstr (cdar ptrie) (cons (cons str (cdr ptrie)) fallback)))
(my-try-rensearch str (cdr ptrie) fallback)))))
(defadvice isearch-update (after my-migemo-auto-ren activate)
(when (and (featurep 'migemo) migemo-isearch-enable-p ; migemo が on で，
(eq this-command 'isearch-printing-char) ; 検索文字列を伸ばして
(not isearch-success) ; 検索に失敗し，
(save-excursion ;; 残りのバッファを検索しても検索文字列がない場合
(not (funcall
(if isearch-forward 'migemo-backward 'migemo-forward)
isearch-string nil t))))
;; migemo で isearch に失敗したら連文節検索を試みる
(let* ((ptrie (my-gen-renpos-trie (my-ren-pos-list isearch-string 1)))
(renstr (my-try-rensearch isearch-string ptrie '())))
(when renstr
(setq isearch-string renstr
isearch-message isearch-string)
(goto-char isearch-opoint) ; 再検索
(isearch-search)))))さてこのコード、成功するときは割と順調にマッチしてくれますが、失敗する場合、全探索するため結構時間がかかります。また、文節の可能性がある位置が増えるたびに2の冪乗で可能な連文節のパターンも増えるため、変数 max-lisp-eval-depth がデフォルト（300ぐらい）だと、九文節（512の連文節候補）以上が含まれ得る文字列の検索に失敗すると max-lisp-eval-depth の超過エラーが出ます。何らかの方法で探索範囲を制御する必要があるのですが、最初のコードで大体ことは足りるのでこれ以上何かする工夫する意義は無さそうです（前のコードで fallback の深さを制限付きで反復深化するのはやってもいいかも）。
[06/10/21 追記] 前の版と同じような動作をするコードを xyzzy 用に書いている方がいた。同じようなことは考えつくものだ。
[06/11/10 追記] migemo を使っていると、たまにキャッシュファイル .migemo-pattern が壊れて migemo の検索ができなくなるときがあります。そういう場合は、advice 中で「; 残りのバッファを検索しても検索文字列がない」かどうか検査するところで必ず失敗するので常に連文節にしようとして動作がおかしくなります。どのみち migemo 自体も正常に動かないので、そのときはキャッシュファイルを .migemo-pattern を消すとまともに動くようになると思います。
デフォルトの emacs、あるいは emacs lisp パッケージの動作で、気になるところを改善する emacs lisp です。ストレスを生じる動作を見つける度にそれらを直す emacs lisp を追加していっています。
*scratch* バッファを kill-buffer してしまったり、*scratch* バッファに書いた内容をファイルに保存してしまうと *scracth* バッファが消えてしまって困るときがあります。そこで、それらのときに *scratch* バッファが消えないようにします。
(defun my-make-scratch (&optional arg)
(interactive)
(progn
;; "*scratch*" を作成して buffer-list に放り込む
(set-buffer (get-buffer-create "*scratch*"))
(funcall initial-major-mode)
(erase-buffer)
(when (and initial-scratch-message (not inhibit-startup-message))
(insert initial-scratch-message))
(or arg (progn (setq arg 0)
(switch-to-buffer "*scratch*")))
(cond ((= arg 0) (message "*scratch* is cleared up."))
((= arg 1) (message "another *scratch* is created")))))
(add-hook 'kill-buffer-query-functions
;; *scratch* バッファで kill-buffer したら内容を消去するだけにする
(lambda ()
(if (string= "*scratch*" (buffer-name))
(progn (my-make-scratch 0) nil)
t)))
(add-hook 'after-save-hook
;; *scratch* バッファの内容を保存したら *scratch* バッファを新しく作る
(lambda ()
(unless (member (get-buffer "*scratch*") (buffer-list))
(my-make-scratch 1))))この emacs lisp により、*scratch* バッファで kill-buffer した場合はバッファの内容をクリアし、*scratch* バッファの内容を名前をつけて保存したときには新しく *scratch* バッファを作ります。案外便利かも。
なお、*scratch* で間違って kill-buffer して内容がからっぽになってしまったときは、erase-buffer しているだけなので、undo すれば元に戻ります。
XEMACSの付属パッケージに permanent-buffers.el というのがあって、任意のバッファに対して同じようなことができるそうです。
migemo を使うと、かな漢字交じりの日本語を検索する際に、辞書を使ってローマ字を動的に漢字かな文字に展開することで、アルファベットのままインクリメンタル検索することができます。この migemo での検索をより快適にするために、二つの emacs lisp を書いてみました。
まず、isearch で IME をオフにします。migemo を使っていれば、isearch で 日本語を打つ必要は無いはずです。[meadow-users-jp: 1340] Re: fep control on minibuffer と ふかふかの xyzzy tips を参考に以下のような emacs lisp を書いてみました。
;; IME がオンなら isearch に入るときに呼ばれる hook でオフにする
(add-hook 'isearch-mode-hook
(lambda () (when (fep-get-mode) (fep-force-off))))
;; IME がオンだったのなら isearch を出るときに呼ばれる hook でオンに戻す
(add-hook 'isearch-mode-end-hook
(lambda () (when mw32-ime-state (fep-force-on))))
;; defadvice を使う場合
;; (defadvice isearch-mode (before my-ime-off activate)
;; (when (fep-get-mode) (fep-force-off)))
;;
;; (defadvice isearch-done (after my-ime-off activate)
;; (when mw32-ime-state (fep-force-on)))mw32-ime-mode-line-state-indicator（mode-lineの一番左のIMEオンオフのマーカー）はいじらないので、万が一変なことが起きたら(fep-mode-off)（マーカーがオフなのにオンになっているとき）(fep-mode-on)（マーカーがオンなのにオフになっているとき）を実行してください。まぁ isearch はちゃんと実装されているのでそんなことは無いとは思います。
追記: wrap-function-to-control-ime を使った方法だと、以下のようになります。isearch-mode を wrap できないのはどうしてなのだろう。
(wrap-function-to-control-ime 'isearch-forward t nil)
(wrap-function-to-control-ime 'isearch-forward-regexp t nil)
(wrap-function-to-control-ime 'isearch-backward t nil)
(wrap-function-to-control-ime 'isearch-backward-regexp t nil)追記: meadow3 では色々と動きがあるようです。isearch時のIME制御方法をフォローしてください。
migemo を使うと、普通に英語の単語などを検索するときにも（それをローマ字とみなして）かな漢字に動的な展開してしまうので、検索が（普通の isearch で英語の単語を検索するときに比べて）重くなってしまいます。これを避けるためには、C-u C-s を代わりに使うという手がありますが、これだとユーザはそのたびごとに isearch のコマンドを C-s か C-u C-s かで打ち変える必要があり、面倒です。
もちろん、ユーザの入力だけからローマ字かどうか（かな漢字に展開する必要があるかどうか）を正しく判断するのは不可能ですが、例えばバッファの文字コードを調べて、（プログラムや英語の論文などのファイルのような）明らかに日本語を含まないバッファだと分かれば、そのようなバッファに対する検索は100%普通の isearch で検索して良いはずです。そこで、普通に非日本語の文書で isearch をするときに migemo をオフにして検索するための簡単な elisp を考えてみました。
以下では、buffer-file-coding-system を調べて、migemo をオフにするようにしています。これでちょっと検索が速くなるはずです。
;; buffer-file-coding-system から言語判別
;; unicode も入れた方がいいのかも。
(defun my-language-check (lang)
(let ((coding (coding-system-base buffer-file-coding-system)))
(memq coding (cdr (assoc 'coding-system
(assoc lang language-info-alist))))))
;; 日本語じゃないときは migemo を使わない
(eval-after-load "migemo"
'(progn
(defadvice isearch-mode (before my-migemo-off activate)
(unless (my-language-check "Japanese")
(make-local-variable 'migemo-isearch-enable-p)
(setq migemo-isearch-enable-p nil)))
(add-hook 'isearch-mode-end-hook
(lambda ()
(unless (my-language-check "Japanese")
(setq migemo-isearch-enable-p t))))))isearch-mode に対する defadvice と isearch-mode-end-hook とに、文字コードを判別するに関数を入れて migemo をオフ・オン しているのが非対称的で気持ち悪いが、migemo が isearch-message-prefix など isearch-mode-hook が動く前に実行される関数に defadvice しているので、仕方ない。(04/11/16) 起動時ではなく後から migemo を読み込む設定にしていてもいいように eval-after-load に変更した。
C-x C-f (find-file) は基本的に、既存のファイルを使うときと、新しいファイルを作るときに使います（後者はやや慣例的）。しかし、既存のファイルを開くつもりで、TAB や SPC で補完していて、補完対象が複数あって最後まで補完されず、勢いで RET を押すと新しいファイルを作って嫌な気持ちになります。そこで試しにこんなのを作ってみました。
(defadvice find-file (before my-find-file-if-exists activate)
(let ((file (ad-get-arg 0)))
(while (and (not (file-exists-p file)) ;; ファイルが存在しなくて
(or ;; 直前のコマンドが TAB や SPC による補完だったのなら
(eq last-command 'minibuffer-complete)
(eq last-command 'minibuffer-complete-word)
(eq last-command 'hc-exit-and-then) ;; highlight-completion 用
))
(message "File %s does not exist." file)
(sit-for 0.8)
(setq file (read-file-name "Find File: " file file)))
(ad-set-arg 0 file)))TAB や SPC で補完した直後に RET を押した場合に、そのファイルが存在しなければ再入力を促す（そのままもう一度 RET を押せば新しいファイルとして開ける）ようになります。
追記 (04/11/11): これ、便利だったのに、meadow 2.10 (emacs 21.3) 以降で動かなくなってしまった。2.10 で動かない理由は良く分からなかったが、2.20 では files.el で定義されている関数が軒並み find-file-read-args で引数を読みに行くようになっていたので上の代わりに、read-file-name に以下のように defadvice すると動いた。
(defadvice read-file-name (after my-read-file-if-exists activate)
(let ((file ad-return-value))
(while (and (not (file-exists-p file)) ;; ファイルが存在しなくて
(or ;; 直前のコマンドが TAB や SPC による補完だったのなら
(eq last-command 'kogiku-complete)
(eq last-command 'minibuffer-complete)
(eq last-command 'minibuffer-complete-word)
;; (eq last-command 'hc-exit-and-then) highlight-completion 用
))
(message "File %s does not exist." file)
(sit-for 0.8)
(setq file (apply 'read-file-name
(append (list (ad-get-arg 0) file file) (ad-get-args 3)))))
(setq ad-return-value file)))追記 (05/01/04): 気になったので、interactive 関数の C の実装 (callint.c) をみてみたら、Meadow が2.10で import した「interactive の実行前の this-command と last-command を実行後に復元する」という emacs の CVS HEAD のコードにより上記のコードが有効にならないようだ。これは流石にどうしようもないなあ。というわけで、2.10 ではfind-file 自体を書き換えるしか方法が無い。
ミニバッファの履歴に重複を残さないようにする emacs lisp は ヒストリから重複を削除 (Meadow Memo) を使えばいいですが、時々、重複したの以外のも消したくなるときがあります。例えば、ファイルを新しく開いたけど、保存しなかったとか、間違った名前で開いてしまったとか（一番多いと思われる、補完していて勢い余ってというパターンについては、find-file で補完し損なって新しいファイルを開くのをなんとかしてして大丈夫なのですが）。とりあえずここではこのようなファイル履歴を消してみることにします。他にも拡張するかもしれません。
;; ミニバッファの履歴の重複削除＋ファイル履歴から読み込めないファイルを削除
(defun my-minibuffer-delete-duplicate ()
(let ((hist (symbol-value minibuffer-history-variable)))
(when (and (listp hist) (> (length hist) 1)) ;; 履歴を記録する履歴が存在するときのみ
(let ((last (car hist)))
(when (eq minibuffer-history-variable 'file-name-history)
;; $HOME や ".." や "." は正則化する
(let ((home-re (concat "^" (expand-file-name (getenv "HOME"))))
(fn (expand-file-name last)))
;; (unless (file-readable-p last)
;; (set minibuffer-history-variable (cdr hist)))
(when (string-match home-re fn)
(setq last (replace-match "~" t t fn)))))
(set minibuffer-history-variable (cons last (delete last (cdr hist))))))))追記 (25/04/28): 最近の emacs でたまにエラーを吐くようになっていたので、修正。調べたところ、ファイルを上書き保存したときなど、履歴を記録しないときに minibuffer-history-variable がリストではなく真偽値 t を取るようになっていたのが原因だった。
ミニバッファの履歴で消したいものがあるときに、C-delete で消すための elisp です。
;; ミニバッファの履歴を編集
(defun my-delete-history-element ()
(interactive)
(let* ((hist (symbol-value minibuffer-history-variable))
(curr (nth (1- minibuffer-history-position) hist)))
(set minibuffer-history-variable (delete curr hist))
(next-history-element 1)))
;; C-delete で削除
(define-key minibuffer-local-map [\C-delete] 'my-delete-history-element)prolog の一般的な拡張子は .pl で、かつ、perl の一般的な拡張子も .pl。メジャーモードの設定は拡張子ごとにするのでこれは困ります。というわけで、 prolog-mode および cperl-mode で、ファイルの先頭 "#!" があるかないかで適切なモードに switch する設定を書いてみました（というか，interpreter-mode-alist が auto-mode-alist より優先されてくれればそれで済むのだけれど）。
;; バッファが prolog か perl プログラムかをチェック
(defun my-pl-switch ()
(save-restriction
(widen)
(if (string= "#!" (buffer-substring 1 (min 3 (point-max))))
(cperl-mode)
(prolog-mode))))
(defadvice prolog-mode (after my-pl-switch activate)
(make-local-hook 'after-save-hook) ;; emacs 21.1 以前のみ必要
(add-hook 'after-save-hook 'my-pl-switch t t))
;; おまけ
(defadvice cperl-mode (after my-pl-switch activate)
(make-local-hook 'after-save-hook) ;; emacs 21.1 以前のみ必要
(add-hook 'after-save-hook 'my-pl-switch t t))
prolog-mode-hook に引っ掛けた簡略版は以下に。after-save-hook に引っ掛けてるわけじゃないので，#! を書いてから保存してください（書く前に保存した場合はファイルを開き直してください）。
(defun my-pl-switch ()
(save-restriction
(widen)
(if (string= "#!" (buffer-substring 1 (min 3 (point-max))))
(cperl-mode))))
(eval-after-load "prolog"
'(add-hook 'prolog-mode-hook 'my-pl-switch))外部コマンドを別プロセスで呼び出す emacs lisp です。
latexmk を呼び出す LaTeX のコンパイルをちょっと手直ししたもの。オプションスイッチとエラージャンプが追加されています。後は、細かい仕様の訂正。コンパイルが始まると、下に別 window を開いてコンパイルログを表示します。ログ window にカーソルがある間は、ログウィンドウは閉じません。また、コンパイルしている間は ログ window は閉じず、コンパイルが停止したときに、閉じます。その際、エラーで停止していた場合は当該箇所にジャンプします。
(defvar my-ltxmk-window-height 3)
(defvar my-ltxmk-window-pos 0)
(defvar my-ltxmk-log "*Latemk Compile-Log*")
(defvar my-ltxmk "c:/cygwin/usr/local/bin/platexmk.prl")
(defvar my-ltxmk-opt-alist
(let ((ltxmkrc "/cygdrive/c/cygwin/home/administrator/.platexmkrc"))
`(("pdf" . ,(concat "-r " ltxmkrc " -f -pdfdvi")) ; pdf
("psv" . ,(concat "-r " ltxmkrc " -ps -f -pv")) ; ps preview
("ps" . ,(concat "-r " ltxmkrc " -ps -f")) ; ps
("dvi" . ,(concat "-r " ltxmkrc " -f")) ; dvi
("dviv" . ,(concat "-r " ltxmkrc " -f -pv")) ; dvi preview
("c" . ,(concat "-r " ltxmkrc " -C"))))) ; clean
(defvar my-ltxmk-timer nil)
;; (defun my-latex (tex)
(defun my-latex ()
"Compile tex file using latexmk"
(interactive)
;; (interactive "fTeX file: ")
;; (let ((file (file-name-nondirectory tex)))
(let ((file (file-name-nondirectory (buffer-file-name))))
(when my-ltxmk-timer ;; 前の timer を消す前に次のコンパイルの実行を始めた
(cancel-timer my-ltxmk-timer)
(when (get-buffer-window my-ltxmk-log)
(delete-window (get-buffer-window my-ltxmk-log))))
(when (get-process "Shell") (delete-process "Shell")) ;; * いい加減
(let* ((dop "dvi") ;; default option
(opt (assoc-default
(completing-read
"option: " my-ltxmk-opt-alist nil nil nil nil dop)
my-ltxmk-opt-alist)))
(save-window-excursion
(shell-command (format "%s %s %s &" my-ltxmk opt file) my-ltxmk-log))
(set-window-buffer
(if (>= (- (window-height) my-ltxmk-window-height) 4)
;; 分割可能な window なら分割して表示
(split-window
(selected-window)
(- (window-height) (1+ my-ltxmk-window-height)))
(next-window))
my-ltxmk-log))
(setq my-ltxmk-timer
(run-at-time
1 2
(lambda ()
(let* ((pmax (with-current-buffer my-ltxmk-log (point-max)))
err errl errs)
(cond ((= pmax my-ltxmk-window-pos) ; コンパイル停止していたら
(unless (eq (selected-window)
(get-buffer-window my-ltxmk-log))
(save-excursion
(with-current-buffer my-ltxmk-log
(goto-char (point-max))
(beginning-of-line)
(when (setq err (re-search-forward "^? " nil t))
(forward-line -2)
(re-search-forward "^l.\\(.+\\) \\(.+\\)" nil t)
(setq errl (string-to-number (match-string 1))
errs (match-string 2)))))
(when err ; エラーで停止した場合はエラーにジャンプ
(goto-line errl)
(search-forward errs nil t))
(delete-window (get-buffer-window my-ltxmk-log))
(cancel-timer my-ltxmk-timer)))
(t (setq my-ltxmk-window-pos pmax)))))))))コマンドを覚える記憶力があれば、Yet Another LaTeX mode for EmacsとかAUCTeX: An integrated TeX/LaTeX environmentを使うのが良いと思います。キーバインディングが覚えられなかったり、メニューを使わなかったり、結局文章を考えたり書くのが全体の大部分を占めていてコンパイル以外の機能の必要が無い場合には意味があるかも。
[既存の不具合] meadow 終了時に 別プログラムで previewer を立ち上げているとプロセス終了の問い合わせが発生する。run-at-time の例外処理が多分ちゃんと出来ていない。
[05/01/15] コンパイルが停止してタイマーが走査する前にコンパイルを実行するとき, 前のプロセスを終了するようにしたの不具合を修正。
この emacs lisp は detex がインストールされていることを前提としています。detex のインストールなどについては、DeTeX Home Page を参考にしてください。以下を .emacs に追加すれば、LaTeX-mode で編集している TeX ファイルに detex をかけた後に wc を使って単語数を数えることが出来ます。
(defun my-tex-wc ()
(interactive)
(let* ((wc-filter "detex -l")
(wc "wc -w")
(ws (shell-command-to-string
(concat wc-filter " " buffer-file-name " | " wc))))
(string-match "[0-9]+" ws)
(message "File %s includes %s words." (buffer-name) (match-string 0 ws))))
;; latex-mode のときに\M-sで単語数を数える
;; auctex を使ってれば 'latex-mode-hook -> 'LaTeX-mode-hook（以下同様）
(add-hook 'latex-mode-hook (lambda () (local-set-key "\M-s" 'my-tex-wc)))モードラインに表示して、一定時間ごとに update したいなら、簡単には下のようにすれば良いでしょう。display-time の timer を使ってややいい加減に実装。
(defun my-tex-wc-up ()
(let* ((wc-filter "detex -l")
(wc "wc -w")
(ws (shell-command-to-string
(concat wc-filter " " buffer-file-name " | " wc))))
(string-match "[0-9]+" ws)
(match-string 0 ws)))
(add-hook 'latex-mode-hook
(lambda ()
(make-local-variable 'display-time-string-forms)
(make-local-variable 'display-time-string)
(setq display-time-string-forms
(cons
`(format (concat "\(" (funcall 'my-tex-wc-up) " words\) "))
display-time-string-forms))
;; 時間調節する場合（秒単位）
(setq display-time-interval 10)
(display-time)
;; save するたびに word count を更新したい場合
(add-hook 'after-save-hook (lambda () (display-time)))))tramp 経由で編集しているときは、下記のように一時ファイルに書き出すようにすればよいです。tramp の処理に介入してもできそうですが。Thanks: 綱川君。
(defun my-tex-wc-up ()
(interactive)
(let* ((wc-filter "detex -l")
(wc "wc -w")
(tmp-file-path "~/tmp.tex")
(dummy (write-region (point-min) (point-max) tmp-file-path nil 0))
(ws (shell-command-to-string
(concat wc-filter " " tmp-file-path " | " wc))))
(string-match "[0-9]+" ws)
(delete-file tmp-file-path)
(message (match-string 0 ws))))フィルターの必要の無い単純な word count なら M-x how-many RET [-\w]+ RET でできます。また、（参照: [meadow-users-jp: 2008] Re: Word Count?）、word-count-mode というのが LaTeX 文書にも対応しているそうです。他にも、detex を使うもので似たようなのを見つけました。
追記 (05/01/03): Emacs 21 には標準の tex-mode.el に tex-count-words という述語が定義してありますが、現状ではコメント行や環境を考えずカウントしてしまうようです。
emacs の気になるところ。elisp のネタ。