VC++ で Boost を使ったプログラムを static link でビルドする

Boost に限らず、静的リンクした exe を作るには、

VC++ メニュー / プロジェクト / 構成プロパティ / コード生成

ランタイムライブラリ を マルチスレッド (/MT) にする。

配布前の Release ビルド だけで設定しとくのが吉。

クロージャ

いままで、「ふーん」くらいにしか思ってなかったけど、すごく分かりやすい解説を見つけたのでメモる。

猿でもわかるクロージャ超入門

xyzzy でやってみる。

;; 問題：呼び出すたびに、1,2,3,...を返すような関数 f(　)を定義せよ。
(defun outer ()
(let ((x 0))
(defun inner ()
(incf x))))

(setq f (outer))

;; test
(funcall f)
;=>1

(funcall f)
;=>2

(funcall f)
;=>3

クロージャ、「使える！」と思った。

仮置き: cl 用の小物（作りかけ）

適当に作った clozure CL 用の cl-mode と、その native-compile 用のコマンド。

scheme-mode をパクらせていただいた。

念のために、作りかけを置いとく。プロセス周りがかなり怪しい。



cl-mode.l

;;; -*- Mode: Lisp; Package: EDITOR -*-
;;;
;;;
; cl-mode
; based on scheme-mode (wrote by MATSUOKA Hiroshi)
;
(require "lispmode")
(provide "cl-mode")

(in-package "editor")
(export '(*cl-mode-hook*
*cl-keyword-file*
*cl-mode-map*
*cl-indent-map*
cl-mode
*cl-run-command*
*cl-run-pop-to-args*
make-cl-scratch
*cl-mode-scratch-buffer*
*cl-process*
*cl-process-open-hook*
*cl-process-close-hook*
*cl-process-send-filter*
*cl-process-read-filter*
*cl-view-mode-map*
*cl-mode-version*
cl-view-mode))

(defvar *cl-mode-version* "based-scheme-mode-20090118")
;;; cl-mode
(defvar *cl-mode-map* nil)
(unless *cl-mode-map*
(setq *cl-mode-map* (make-sparse-keymap))
(define-key *cl-mode-map* #\RET 'lisp-newline-and-indent)
(define-key *cl-mode-map* #\LFD #'(lambda () (interactive) (cl-eval-last-sexp) (newline)))
(define-key *cl-mode-map* '(#\C-c #\C-e) 'cl-eval-current-buffer)
(define-key *cl-mode-map* #\TAB 'lisp-indent-line)
)

(defvar *cl-process* nil)
(defvar *cl-process-open-hook* 'cl-default-open-hook)
(defvar *cl-process-close-hook* nil)
(defvar *cl-process-send-filter* 'cl-default-send-filter)
(defvar *cl-process-read-filter* 'cl-default-read-filter)

(defvar *cl-run-command* nil)
(defvar *cl-run-pop-to-args* nil)
(defvar *cl-keyword-hash-table* nil)
(defvar *cl-keyword-file* "cl")
(defvar *cl-mode-scratch-buffer* "*cl scratch*")

(defun cl-default-send-filter (proc sexp)
(format nil "~A\r\n" sexp))

(defun cl-default-read-filter (proc text)
(when *cl-run-pop-to-args*
(unless (find-buffer (car *cl-run-pop-to-args*))
(save-excursion
(switch-to-buffer (car *cl-run-pop-to-args*))
(setup-temp-buffer (selected-buffer))))
(apply 'pop-to-buffer *cl-run-pop-to-args*))
(insert text)
(set-window (get-buffer-window (process-buffer proc)))
(refresh-screen))

(defun cl-default-open-hook (buffer)
(set-buffer buffer)
(make-process *cl-run-command*))

(defun cl-open-process ()
(interactive)
(when (null *cl-process*)
(let* ((process (funcall *cl-process-open-hook* (selected-buffer))))
(setf *cl-process* process)
(when *cl-process*
(set-process-sentinel
*cl-process*
#'(lambda (proc)
(when *cl-process-close-hook*
(funcall *cl-process-close-hook* proc))
(setf *cl-process* nil)))
(set-process-filter *cl-process* *cl-process-read-filter*))))
*cl-process*)

(defun cl-eval-string (sexp)
(when sexp
(let ((process (cl-open-process)))
(when process
(process-send-string process (funcall *cl-process-send-filter* process sexp))))))

(defun cl-eval-current-buffer ()
(interactive)
(let* ((text (buffer-substring (point-min) (point-max))))
(when (and text (> (length text) 0))
(cl-eval-string text))))

(defun cl-eval-last-sexp()
(interactive)
(save-excursion
(let* ((p (point))
(s (progn (backward-sexp) (point)))
(e (progn (forward-sexp) (point)))
(text (buffer-substring s e)))
(goto-char p)
(when (and text (> (length text) 0))
(cl-eval-string text)))))

(defvar *cl-mode-abbrev-table* nil)
(unless *cl-mode-abbrev-table*
(define-abbrev-table '*cl-mode-abbrev-table*))

; completion
(defvar *cl-completion-list* nil)
(defun cl-completion ()
(interactive)
(or *cl-completion-list*
(setq *cl-completion-list*
(make-list-from-keyword-table *cl-keyword-hash-table*))
(return-from cl-completion nil))
(let ((opoint (point)))
(when (skip-syntax-spec-backward "w_")
(let ((from (point)))
(goto-char opoint)
(do-completion from opoint :list *cl-completion-list*)))))

(defvar *cl-mode-hook* nil)
(defun cl-mode ()
(interactive)
(kill-all-local-variables)
(setq mode-name "CL")
(setq buffer-mode 'cl-mode)
(use-keymap *cl-mode-map*)
(use-syntax-table *lisp-mode-syntax-table*)
(and *cl-keyword-file*
(null *cl-keyword-hash-table*)
(setq *cl-keyword-hash-table*
(load-keyword-file *cl-keyword-file* t)))
(when *cl-keyword-hash-table*
(make-local-variable 'keyword-hash-table)
(setq keyword-hash-table *cl-keyword-hash-table*))
(when *cl-mode-abbrev-table*
(setq *local-abbrev-table* *cl-mode-abbrev-table*))
(run-hooks '*cl-mode-hook*))

(defun make-cl-scratch ()
(interactive)
(switch-to-buffer *cl-mode-scratch-buffer*)
(cl-mode)
(make-local-variable 'need-not-save)
(setf need-not-save t)
(make-local-variable 'auto-save)
(setf auto-save nil))

;;; cl-mode.l ends here

cl-native-compile.l

;;; cl-native-compile.l
;;;

(require "cl-mode")

(provide "cl-native-compile")


(defvar *cl-native-compile-template* (merge-pathnames "etc/cl-compile-template-ccl" (si:system-root))
"コンパイルスクリプトを生成するテンプレートファイルを指定")

(defvar *cl-native-compile-script-name* "compile-ccl.lisp"
"コンパイルスクリプトのファイル名")

(defvar *cl-native-compile-top-level-func-name* nil
"トップレベル関数の名前を文字列で指定する。
nil なら、ソースファイルの一番上の defun をトップレベル関数とみなす。")

(defun cl-native-compile ()
(interactive)
(let ((fn (get-buffer-file-name))
(ext "lisp"))
(if (interactive-p)
(cond (fn (when (and (buffer-modified-p)
(string= (pathname-type fn) ext))
(save-buffer))
(call-interactively 'cl-native-compile-1))
(t (call-interactively 'emacs-write-file)
(cl-native-compile-internal (get-buffer-file-name))))
(cl-native-compile-internal fn))))

(defun cl-native-compile-1 (filename)
(interactive "fNative compile file: " :default0 (get-buffer-file-name))
(cl-native-compile-internal filename))

(defun cl-native-compile-internal (filename)
(let ((script (cl-native-compile-create-compile-script filename)))
(when script
(cl-native-compile-kick-compile-command script))))

(defun cl-native-compile-kick-compile-command-dos (script)
"DOS窓を開いてコンパイルを実行する。"
(let* ((ccl (map-slash-to-backslash *cl-run-command*))
(script (pathname-name script))
(dir (directory-namestring script))
(cmd (format nil "cmd.exe /c ~A --no-init --load ~A" ccl script)))
(call-process cmd :exec-directory dir :show :show)
cmd))

(defun cl-native-compile-kick-compile-command (script)
"バッファを開いてコンパイルを実行する。"
(let* ((ccl (map-slash-to-backslash *cl-run-command*))
(script (pathname-name script))
(dir (directory-namestring script))
(cmd (format nil "~A --no-init --load ~A" ccl script))
(buf (get-buffer-create "*cl-native-compile*"))
(proc (progn (execute-subprocess cmd nil buf nil dir)
(buffer-process buf))))
(sleep-for 0.5)
(switch-to-buffer buf)
;(process-send-string proc (concat cmd "\n"))
;(insert "\n")
;(kill-process proc)
cmd))

(defun cl-native-compile-create-compile-script (lisp-path)
"native compile 用のスクリプトを生成しファイル名を返す。すでにある場合は生成せず、そのファイル名を返す。"
(let ((template *cl-native-compile-template*)
(script (merge-pathnames *cl-native-compile-script-name* (directory-namestring lisp-path)))
temp-buffer top-level ret)
(cond ((file-exist-p script) (setq ret script))
((null (file-exist-p lisp-path)) (error "ソースファイル ~A がありません。" src))
((null (file-exist-p template)) (error "テンプレートファイル ~A がありません。" template))
(t (unwind-protect
(progn
(setq temp-buffer (create-new-buffer "*cl-native-compile*"))
(set-buffer temp-buffer)
(insert-file-contents lisp-path)
(setq top-level (cl-native-compile-get-top-level-func))
(cond ((null top-level) (error "トップレベル関数が見つかりません。"))
(t
(progn
(erase-buffer temp-buffer)
(insert-file-contents template)
(cl-native-compile-replace-template lisp-path top-level)
(write-file script)
(setq ret script)))))
(when temp-buffer
(delete-buffer temp-buffer)))))
ret))

(defun cl-native-compile-replace-template (lisp-path top)
(let ((src (file-namestring lisp-path))
(exe (concat (pathname-name lisp-path) ".exe")))
(goto-char (point-min))
(replace-buffer "{TIME-STAMP}" (format-date-string "%Y.%#m.%#d  %H:%M:%S (%z)") :once t)
(goto-char (point-min))
(replace-buffer "{SRC-NAME}" src)
(goto-char (point-min))
(replace-buffer "{EXE-NAME}" exe)
(goto-char (point-min))
(replace-buffer "{TOP-LEVEL-FUNC}" top :once t)
(goto-char (point-min))))

(defun cl-native-compile-get-top-level-func ()
"ソースファイルからトップレベル関数を探して関数名を返す。
もし、*cl-native-compile-top-level-func-name* が non-nil なら探さずに、無条件にその値を返す。"
(cond (*cl-native-compile-top-level-func-name*)
(t
(let ((re "^ *( *defun +\\(.+\\) +"))
(if (scan-buffer re :regexp t)
(match-string 1)
nil)))))

clozure CL 用の設定

;;; cl-mode
(require "cl-mode")
(push '("\\.lisp$" . cl-mode) *auto-mode-alist*)

; インタプリタの起動コマンド (clozure CL)
(setf *cl-run-command*
(format nil "\"~A\""
(map-slash-to-backslash "D:/util/ccl/wx86cl.exe")))

; インデントを空白に
(add-hook '*cl-mode-hook*
#'(lambda ()
(ed::set-buffer-local 'indent-tabs-mode nil)))
; 評価結果を別窓にしたい場合
(setf *cl-run-pop-to-args* '("*cl run*" 2 nil))
(define-key *cl-mode-map* #\LFD #'(lambda () (interactive) (ed::cl-eval-last-sexp)))

(defalias 'cl 'make-cl-scratch)

xyzzy/etc/cl-compile-template-ccl（コンパイル用のテンプレートファイル）

;;; compile-ccl.lisp
;;;
;;; compile script for Clozure CL
;;; THIS FILE IS AUTOMATICALLY CREATED BY `cl-native-compile.l'.
;;;
;;;   created: {TIME-STAMP}
;;;   source:  {SRC-NAME}
;;;   out:     {EXE-NAME}

(load "./{SRC-NAME}")

(format t "now compiling...")

(ccl:save-application "{EXE-NAME}"

;;; compile-ccl.lisp ends here

scratch バッファ専用の auto-save-buffers

scratch バッファでプログラムをテストしてると、まれに xyzzy がフリーズしてしまうことがある。フリーズすると、いままで scratch バッファで書いてたものがパーになるのでつらい。

そこで scratch バッファだけを RAM ディスクに自動保存するようにしてみた。

tips/xyzzyでファイルの自動保存をパクらせてもらった。

;;; auto-save-scratch-buffer
;;;
;;; *scratch* バッファ専用の auto-save-buffers
;;; 保存先は RAM disk を想定
;;;
;;; インストール (下の一行を .xyzzy に書く)
;;;   (require "auto-save-scratch-buffer")

(provide "auto-save-scratch-buffer")
(in-package "editor")

(export '(auto-save-scratch-buffer
*auto-save-scratch-buffer-interval*
*auto-save-scratch-buffer-path*))

(defvar *auto-save-scratch-buffer-p* nil
"auto-save-scratch-buffer で保存中なら non-nil")

(defvar *auto-save-scratch-buffer-interval* 10
"自動保存するまでのアイドル時間")

(defvar *auto-save-scratch-buffer-path* "R:/scratch"
"自動保存するファイルの path")

(defun auto-save-scratch-buffer ()
"scratch バッファを自動セーブする"
(let ((buf (find-buffer "*scratch*")))
(when (and (eq (selected-buffer) buf)
(buffer-modified-p buf)
(check-valid-pathname (directory-namestring *auto-save-scratch-buffer-path*)))
(setf *auto-save-scratch-buffer-p* t)
(set-buffer buf)
(write-file *auto-save-scratch-buffer-path* t)
(set-buffer-modified-p nil buf)
(refresh-screen 0)
(message "saved scratch.")
(setf *auto-save-scratch-buffer-p* nil))))

(add-hook '*post-command-hook*
#'(lambda ()
(stop-timer 'auto-save-scratch-buffer)
(start-timer *auto-save-scratch-buffer-interval* 'auto-save-scratch-buffer t)))

;;; auto-save-scratch-buffer ends here

インストール

1. 上記を auto-save-scratch-buffer.l として site-lisp に保存。byte-compile。


2. .xyzzy に (require "auto-save-scratch-buffer") を足す。

デフォでは 10秒おきに保存。

そういえば、emacs でも同じようなのを書いたような･･･。

Git Bash の home ディレクトリを指定する

windows の git をふつうにインストールすると、$HOME が

/c/Documents and Settings/<windows のユーザ名>

となってて気持ち悪い。windows の環境変数で HOME を設定してないとこうなる。

システムのプロパティから環境変数を設定すればいいんだけど、めんどくさいので ショートカットで HOME を指定することにした。

Git Bash というショートカットアイコンがデスクトップにあるので、これのプロパティを開いて、リンク先と作業フォルダを設定する。

たとえば、マイドキュが D:\docu で、git のインストール先が d:\Git の場合は、下記のように変更。

リンク先:
C:\WINDOWS\system32\cmd.exe /c "set HOME=D:\docu & D:\Git\bin\sh.exe --login -i"

作業フォルダ:
D:\docu

これで、デスクトップの Git Bash アイコンから起動する限り、~は D:\docu を指すようになる。

でもしょせんは、 cmd.exe なんだよなあ。

ビルトイン関数かどうか

以前から探してて、あるにはあった。

ココによると、 si::*builtin-function-p だそうな。

ただ、ちょっと使いにくいので、ラップしとく。

(defun builtin-function-p (symbol)
"symbol がビルトイン関数かどうかを返す。"
(and (fboundp symbol)
(si::*builtin-function-p (symbol-function symbol))))

テンポラリなバッファを作る

他のアプリからテキストをコピペして置換とかするとき、一時的なバッファがほしくなるときがある。

(if (fboundp 'temp-buffer)
(msgbox "`temp-buffer' という関数はすでに存在します。")
(defun temp-buffer ()
(interactive)
(set-buffer (create-new-buffer "*temp*"))
(setq need-not-save t)
(setq auto-save nil)))

M-x temp-buffer で一時的なバッファを作れる。

小さいながら、よく使うコマンド。

※ temp-buffer というありがちな名前が、他の lisp 関数とガッチンコするとまずいので、一応チェックするようにした。

フラグを反転する

フラグの反転くらい、さらっと書きたい。

(setq *hoge-state* (not *hoge-state*))

ってのを

(notf *hoge-state*)

ってやりたい。

(defmacro notf (var)
`(setq ,var (not ,var)))

名前が今ひとつナニだが。

xyzzy で common lisp hyperspec を引いてみる (2)

ココに書いたやつの続き。

hyperspecのコマンドとしては、hyperspec と hyperspec-format がある。

でも ふつうに書いた .xyzzy ("user"パッケージ)からは見えなくて、hyperspec::hyperspec とかしないといけない。hyperspec.l を見る限り、ちゃんと export されているんだが、実に不思議。（←パッケージが分かってない）

というわけで M-x で呼ぶときは M-x hyperspec ではなくて、M-x hyperspec::hyperspec としなければならない。

まあ、見えないなら見えないで、同じ名前で新しくコマンドを作ってやった。

(defun hyperspec ()
"hyperspec をWWWブラウザで開く。ポイント位置が文字列なら、format文字を引く。"
(interactive)
(if (eq (parse-point-syntax) :string)
(call-interactively 'hyperspec::hyperspec-format)
(call-interactively 'hyperspec::hyperspec)))

これを M-x hyperspec として呼ぶと、

• ポイントが文字列の時は hyperspec::hyperspec-format


• そうでないときは hyperspec::hyperspec

となる。

hyperspec::hyperspec-format は format 関数で使う文字を調べるのに使える。

たとえば、

(format nil "~D個見つかりました。" count)

の、"D"にポイントを置いて M-x hyperspec とすると、Dが十進表示だということが分かる。

これは意外と便利。でもなんでか、"~%"は引けない。なんでか。

diigo に置いた画像をテスト

diigo に置いた画像をはてなダイアリーで表示できるかテスト。

どうかな？

一応いけた。･･･と思ったけど、少し時間をおいた後でリロードしてみると、表示されなくなった。

diigo の画像のリンクを見てみると、&Expires= というのがある。ということは、アクセス期限が設定されてるってことか。

というわけで、diigo を画像アップローダとしては使えないっぽい。

他を探そうか。

xyzzy で common lisp hyperspec を引いてみる

common lisp のリファレンスとしては common lisp hyperspec が有名。

xyzzy から common lisp hyperspec を引けるようにしてくれた方がおられた。

http://lispuser.net/emacs/lisphacking.html#sec-4

以下使い方。

1 ココから hyperspec.l を落として、load-path の通ったところに置く。

2 ftp://ftp.lispworks.com/pub/software_tools/reference/HyperSpec-7-0.tar.gz から hyperspec の tar-ball を落として展開し、適当な場所に置く。

3 .xyzzy に下記を書く。

(require "hyperspec")
(setq hyperspec::*hyperspec-root* "~/cl/HyperSpec-7-0/HyperSpec/")
(defvar hyperspec::*hyperspec-symbols-alist* nil)
(defvar hyperspec::*hyperspec-format-characters-alist* nil)

C-c C-h で シンボルを入力すると、デフォルトのWWWブラウザが立ち上がり、リファレンスを参照できるようになる。

関係ないけど、google chrome では ftp できないことがあった。そんなときは ie でやる。

shell-mode で C-k したとき、サブプロセス を消す

これも、だいぶ前に書いたもの。

M-x shell でコマンドプロンプトに入って、作業後に C-k して "サブプロセスが走っています。" とか言われてムキッとなった人に。

けっこう重宝するので貼っておく。

(defun kill-process-and-buffer ()
(interactive)
(let* ((buf (selected-buffer))
(proc (buffer-process buf)))
(when proc
(kill-process proc)
(sleep-for 0.5))
(kill-buffer buf)))

(add-hook 'ed::*shell-mode-hook*
#'(lambda ()
(define-key ed::*shell-mode-map* #\C-\d       'kill-process-and-buffer) ; unix 風に C-d でも抜けるように
(define-key ed::*shell-mode-map* '(#\C-x #\k) 'kill-process-and-buffer)))

フック先を変えれば shell 以外でも使える。

xyzzy で重複行を削除する

CSVファイルとか、XMLのタグ抽出したりとかで、何かと必要になることが多いのが重複行の削除。

xyzzy では C-x # uniq して、外部の uniq.exe を使うのがデフォの様子。

だけど、これぐらいの日常タスクなら xyzzy だけでやりたいと思ったから適当に書いといた。

• 範囲はリージョンで指定する


• 連続して重複していようが、ばらけていようが、2回以上の出現は重複とみなす


• ならびは元のデータに合わせる


• 大文字小文字区別 あり uniq-line-region


• 大文字小文字区別 なし uniq-line-region-case-insensitive

下のようになる。

(元データ)   uniq-line-region    uniq-line-region-case-insensitive
----------   ----------------    ---------------------------------
AAA          AAA                 AAA
ccc          ccc                 ccc
CCC          CCC                 xxx
aaa          aaa                 BBB
AAA          xxx
aaa          BBB
xxx          bbb
BBB
bbb
ccc
aaa
bbb
aaa
aaa

(defun uniq-line-region (from to &optional case-insensitive)
"重複行を削除する。case-insensitive を省略するか nil の場合は、大文字小文字の区別をする。
non-nil のときは大文字小文字を区別しない。"
(interactive "*r")
(save-excursion (save-restriction
(narrow-to-region from to)
(goto-char (point-min))
(let (l)
(loop
(let ((s (buffer-substring (progn (goto-eol) (point)) (progn (goto-bol) (point)))))
(unless (member s l :test (if case-insensitive #'string-equal #'string=))
(setq l (cons s l)))
(unless (forward-line 1) (return))))
(delete-region from to)
(with-output-to-selected-buffer
(map nil #'(lambda (x) (format t "~A~%" x)) (nreverse l)))))))

(defun uniq-line-region-case-insensitive (from to)
"重複行を削除する。大文字小文字を区別しない。"
(interactive "*r")
(uniq-line-region from to t))

似たようなタスクとして、リージョンをソートしたいときは下記が参考になる。

• xyzzyでソート2

refer-for で定義元のソースにジャンプ

refer-for で、

[File ]: なんちゃら.l

の行で enter 押すとそのファイルを開いて、定義の箇所を見れるようにした。

今のところ、対応しているのは下記だけ。

• 関数名


• 変数名


• マクロ名

(defvar *refer-for-jump-dir* `(,(merge-pathnames "lisp" (si:system-root))
,(merge-pathnames "site-lisp" (si:system-root)))
"reference の `File' の欄から *.l を検索するとき、検索対象のディレクトリを指定する。")

(defvar *refer-for-jump-file-read-only* t
"reference の `File' の欄から *.l を開くとき、read-only にするかどうかを指定する。
nil なら普通に開く。non-nil なら read-only で開く。")

(defvar refer-for-jump-file-alist
'(("Accessor"     . 'ignore)
("BufferLocal"  . 'ignore)
("Keyword"      . 'ignore)
("Macro"        . "^[ \t]*\([ \t]*defmacro[ \t]+XXNAMEXX[ \t]+\(") ; 改行も
("Misc"         . 'ignore)
("Special Form" . 'ignore)
("Struct"       . "^[ \t]*\([ \t]*defstruct[ \t]+\([ \t]*XXNAMEXX[ \t]+")
("Tips"         . 'ignore)
("Variable"     . "^[ \t]*\([ \t]*defvar[ \t]+XXNAMEXX[ \t]+")
("Function (interactive)" . "[ \t]*\([ \t]*defun[ \t]+XXNAMEXX[ \t]+")
("Function"     . "[ \t]*\([ \t]*defun[ \t]+XXNAMEXX[ \t]+"))
"`Type'欄と、それをソースファイルから検索するときの正規表現テンプレートの alist。'ignore は「今のところ無視する」という印。")

(defvar refer-for-jump-content-alist '((type    . "^\\[Type       \\]: \\(.+\\)$")
(name    . "^■\\(.+\\)$"))
"*Reference*バッファの欄のシンボルとその検索に使う正規表現の alist")


(defun refer-for-jump-get-content ()
"ポイントが *Reference*バッファの`File'欄や`Type'欄の行にある場合、
欄のシンボルとその後ろの文字列を取得し、多値で返す。見つけられなかった場合は nil を返す。
例: 見つけた場合こんなのを返す 'seealso と \"buffer-read-only\""
(let ((lim (save-excursion (progn (goto-eol) (point)))))
(save-excursion
(goto-bol)
(if (scan-buffer "^\\[\\(.+\\) *\\]: *\\(.*\\)$" :regexp t :limit lim)
(let ((desc (string-trim " \t" (match-string 2)))
(header (intern (nstring-downcase (substitute-string (match-string 1) "[ \t]+" "")))))
(values header desc))))))

(defun refer-for-jump-get-desc-at-point (sym)
"現在参照中のリファレンス項目の 文字列を取得する。
例: 'type --> \"Function (interactive)\" を返す。"
(let ((re (cdr (assoc sym refer-for-jump-content-alist))))
(save-excursion
(when (scan-buffer re :regexp t :reverse t)
(string-trim " \t" (match-string 1))))))

(defun refer-for-jump-file (file)
"reference の `File'欄から定義元のソースファイルを開く。"
(flet ((get-file-path (name)
(find-path-from-top-directory name *refer-for-jump-dir*)))
(let* ((type (refer-for-jump-get-desc-at-point 'type))
(name (refer-for-jump-get-desc-at-point 'name))
(re-template (cdr (assoc type refer-for-jump-file-alist :test #'string=))))
(cond ((null file))
((string= file "builtin.l") (error "ビルトイン関数なので開きません。"))
((null name) (error "reference の 項目名が見つかりません。"))
((null type) (error "reference の Type が見つかりません。"))
((null re-template) (error "Type: ~A には未対応です。" type))
((eq re-template 'ignore))
(t
(let* ((path (get-file-path file))
(buf-new (ed::find-file-internal path)))
(set-buffer buf-new)
(when *refer-for-jump-file-read-only*
(setq buffer-read-only t))
(let ((re (substitute-string re-template "XXNAMEXX" name)))
(unless (scan-buffer re :regexp t)
(delete-buffer buf-new)
(error "定義元が見つかりませんでした。")))))))))

(defun refer-for-jump-seealso (name)
"オリジナルの refer-for-search-seealso とだいたい同機能 (ただし、re は無効)"
(let ((str (format nil "^~A$" (regexp-quote name))))
(refer-for::output (refer-for::search str :by-title t))
(refer-for::set-history str t)))

;;; command
(defun refer-for-jump ()
"ポイントがある行によって、いろんなところへ飛ぶ。
`File'欄にあるときは、ソースファイルを検索する (refer-for-jump-file)
`See also'欄にあるときは、そのリファレンス項目に移動する (refer-for-jump-seealso)"
(interactive)
(multiple-value-bind (header desc) (refer-for-jump-get-content)
(case header
('seealso (refer-for-jump-seealso desc))
('file (refer-for-jump-file desc)))))

(define-key refer-for::*refer-for-mode-map* #\RET 'refer-for-jump)

ほんのすこし doc-string を書く努力をしようと思った。

ファイル名をディレクトリから探してフルパスを返す

(defun find-path-from-top-directory (name dirs)
"name というファイル名をディレクトリ配下で検索して、フルパスを返す。存在しなければ nil を返す。
同名ファイルが複数個存在したとしても、最初に見つけた1つしか返さない。
検索対象のディレクトリはリストで与えてもよい。ディレクトリ名の検索には使えない。"
(flet ((get-path-list (dir wild)
(directory dir :absolute t :recursive t :file-only t :wild wild))
(name-filter (name path)
(let ((n (car (last (split-string path #\/)))))
(if (string-equal name n) path nil))))
(unless (consp dirs) (setq dirs (cons dirs nil)))
(let* ((ext (pathname-type name))
(w (if ext (concat "*." ext) "*"))
find)
(dolist (d dirs)
(when (file-exist-p d)
(setq find (find name (get-path-list d w) :test #'name-filter)))
(when find (return find))))))

きょうの「なんでやねん」

common lisp の教本ばっかり読んでると、シンボルは内部的には大文字になってるんだよなと漠然と思ってた。

なので common な処理系ならなんでも (eq 'HOGE 'hoge ) は t になるんじゃないかと。

xyzzy では下のようになった。

;;; xyzzy
(eq 'hoge 'hoge)
;=> t

(eq 'HOGE 'hoge)                ; おお? 違うのか。
;=> nil

(eq 'nil nil)
;=> t

(eq 'NIL nil)                   ; おおお?
;=> nil

NTEmacs-24 でやったら、xyzzy と同じになった。

ということは、xyzzy は emacs に合わせたんだな。きっと。

ちなみに clozure CL でやってみたら、上記はすべて T だった。

今頃こんなのを書いてること自体あほなんだが、emacs や xyzzy 用に書いたのを他の cl に持っていくときは要注意かもしれず。

xyzzy をリビルドした

とりあえず自分が必要なものだけパッチ当てた。

出先で使えるように Dropbox に入れておいたのでメモ。

http://dl.dropbox.com/u/27772239/xyzzy_bin/xyzzy.exe

http://dl.dropbox.com/u/27772239/xyzzy_bin/xyzzycli.exe

http://dl.dropbox.com/u/27772239/xyzzy_bin/xyzzyenv.exe

http://dl.dropbox.com/u/27772239/xyzzy_bin/rebuild.txt

xyzzy の関数名とかを grep

xyzzy の describe-function は emacs みたいに関数の定義元へのリンクを出してくれないので、毎回 xyzzy のインストール先の lisp ディレクトリ を grep していた。

いい加減めんどくさくなってきたので、専用のコマンドを作った。(かなりテキトーだけど)

;(require "discrete")            ; word-near-point

(defun grep-xyzzy-lisp (name)
(interactive "sName: " :default0 (word-near-point))
(let ((dir-list *load-path*))
(dolist (d dir-list)
(when (file-exist-p d)
(grep-xyzzy-lisp-scan-files name d))))
(switch-to-buffer "*grep*"))

(defun grep-xyzzy-lisp-scan-files (name dir)
(let ((mask "*.l"))
(ed::scan-files name mask dir)))

grep 対象のディレクトリは *load-path* から取得した。

本当は describe-function 自体をうまく改造したいところだけど、今はこれでいいとしとく。

mini9 英語キーボード交換 (US --> US-Intl)

mini9 のキーボードがヘタってきたので、交換することにした。

もともと英語キーボードだったので、今回も英語キーボードに。

ヤフオクで探すと 新品1500円+送料500円 = 2000円というのがあった。中国からEMSで届いたので落札から到着まで7日かかった。キーボード裏面の製造会社名(Sunrex Tech.)とP/Nを見る限り、純正品のようだ。

そして、出品写真では US配列だったけど、届いたのは US-Intl 配列だった。

この US-Intl、5の位置にユーロ記号が書いてあったりして、 初見は違和感があった。しかしレイアウト的にはこっち(US-Intl)の方がマトモだ。

レイアウト比較

BackSpace とスペースバーが小さくなってしまったのは悲しいけど、そんなことは些細なことだ。

それよりも、US-Intlにしたおかげで Ctrlキー役のCapLockがやや広くなって、さらに `(バッククォート)と ~(にょろ)が Fn 押さずに打てるようになったのがうれしい。[] や {} も Fn なしだ。

キートップの印字が若干薄いような気がするが、これはこれで、うるさくなくていい。

しかし、同じ英語キーボードとはいえ、US --> US-Intl の交換では、キーボードコントローラの再設定が必要らしく、Fn + k を押しながらACアダプタをつないで電源ONという手順が必要だった。(US-Intl って、 レイアウト的には UK配列と同じということか）

期せずして US-Intl になったけど、正解だった。

下記は参考にしたサイト

• キーボードの交換手順


• Dell mini9の英語キーボード交換でハマるの巻

encap.l を使ってみる

以前 trace を見つけたときにインストールした、encap.l を使ってみる。

既存の関数を簡単にラップできるみたい。

簡単そうなのを試す。

describe-function したとき、ポイント付近の単語をデフォルト文字列として与える。

(encapsulate 'describe-function
'word-near-point
'((interactive "SApropos(Regexp): " :default0 (word-near-point))
(apply basic-definition argument-list)))

(defun word-near-point ()
"ポイント付近の単語を取得する"
(save-excursion
(buffer-substring (progn (skip-syntax-spec-forward "w_") (point))
(progn (skip-syntax-spec-backward "w_") (point)))))

xyzzy の場合は、 emacs に比べると describe-function の利用価値は少ないから、あんまり便利になるとは思えないけど、まあいいや。

なんか、やってることは emacs の defadvice と変わらない気がしてきた。