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 を書く努力をしようと思った。
