いままで、「ふーん」くらいにしか思ってなかったけど、すごく分かりやすい解説を見つけたのでメモる。
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
クロージャ、「使える！」と思った。
;;; -*- 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 ;;; (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)))))
;;; 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)
;;; 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 バッファでプログラムをテストしてると、まれに 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
デフォでは 10秒おきに保存。
そういえば、emacs でも同じようなのを書いたような･･･。
以前から探してて、あるにはあった。
ココによると、 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)))
名前が今ひとつナニだが。
ココに書いたやつの続き。
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 は format 関数で使う文字を調べるのに使える。
たとえば、
(format nil "~D個見つかりました。" count)
の、"D"にポイントを置いて M-x hyperspec とすると、Dが十進表示だということが分かる。
これは意外と便利。でもなんでか、"~%"は引けない。なんでか。
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 でやる。
これも、だいぶ前に書いたもの。
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 以外でも使える。
(元データ) 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))
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 の 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 自体をうまく改造したいところだけど、今はこれでいいとしとく。
以前 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 と変わらない気がしてきた。
メニューはほとんど使わないので消す。
まったく消してしまうと不安なので、右クリックしたときのコンテキストメニューでメインメニューを出せるようにしとく。
;;; toggle-menu でメインメニュー表示を切り替え
(defvar *main-menu* *app-menu*)
(defun toggle-main-menu ()
(interactive)
(set-menu (setq *main-menu* (if *main-menu* nil *app-menu*))))
;;; デフォでメニューを消しておく
(add-hook '*post-startup-hook*
#'(lambda ()
(set-menu (setq *main-menu* nil))))
;;; コンテキストメニューをすげ替える
(setq *my-menu*
(define-popup-menu
(:item nil "メインメニューを表示(&M)" 'toggle-main-menu)))
(add-hook '*init-app-menus-hook*
#'(lambda ()
(setq *app-popup-menu* *my-menu*)))
上のを .xyzzy に書いておく。
なんか変なのができた。
ふつう scratch バッファは need-not-save が nil なので、xyzzy を終了するときに保存するかどうか、聞かれない。
これは emacs ゆずりのふつうの動作。
ただ、最近はちょこっと lisp のテストコードを書いては終了したりするので、「書き捨て」として扱うには忍びない。
そこでしばらく need-not-save を t にして使っていたんだけど、これはこれで、いちいち保存しますか？と聞いていくるのでうっとおしい。
じゃあ、xyzzy が終了するときに hook して、あらかじめ決めたファイル名で自動的に上書き保存してくれたらいい。
というのを書いてみた。
2011.4.19 変更 xyzzy を終了できなかったのを直した。
;;; scratch-util.l
;;;
;;; scratch buffer utility
;;;
(provide "scratch-util")
(in-package "editor")
;;
(let ((buf (find-buffer "*scratch*")))
(when buf
(with-set-buffer
(set-buffer buf)
(make-local-variable 'need-not-save)
(setq need-not-save nil))))
(export '(scratch-util-save scratch-util-read
*scratch-util-dir* *scratch-util-name*))
(defvar *scratch-util-dir* "~"
"保存ファイルをつくる場所")
(defvar *scratch-util-name* "scratch-bak"
"保存ファイルの名前")
(defvar *scratch-util-buf* "*scratch*")
;; (defun scratch-util-save ()
;; (interactive)
;; (let ((buf *scratch-util-buf*)
;; (path (concat (append-trail-slash *scratch-util-dir*)
;; *scratch-util-name*)))
;; (when (and (buffer-modified-p buf)
;; (< 0 (buffer-size buf)))
;; (with-set-buffer
;; (set-buffer buf)
;; (write-file path t)
;; (set-buffer-modified-p nil))
;; (message "saved."))))
(defun scratch-util-save ()
(let ((buf *scratch-util-buf*)
(path (concat (append-trail-slash *scratch-util-dir*)
*scratch-util-name*)))
(when (and (buffer-modified-p buf)
(< 0 (buffer-size buf)))
(with-set-buffer
(set-buffer buf)
(write-file path t)
(set-buffer-modified-p nil))))
t)
(defun scratch-util-read ()
(interactive)
(let ((buf *scratch-util-buf*)
(path (concat (append-trail-slash *scratch-util-dir*)
*scratch-util-name*)))
(cond ((not (file-exist-p path)) (message "not exist ~A" path))
((> (buffer-size buf) 0) (switch-to-buffer (find-file-internal path))
(lisp-interaction-mode))
(t (switch-to-buffer buf)
(insert-file path)))))
;(define-key ed::*lisp-interaction-mode-map* '(#\C-x #\C-s) 'scratch-util-save)
(add-hook '*query-kill-xyzzy-hook* 'scratch-util-save)
;;; scratch-util ends here
ちなみに scratch-util-read すれば、前回のscratchの内容を読み込む。
まあ、置換とかは replace-buffer とかで一発なんだが、もちょっと凝ったことをしたいときがある。
今まではバッファを1行づつ処理するときは、
(while (null (eobp))
(let* ((beg (save-excursion (goto-bol) (point)))
(end (save-excursion (goto-eol) (point)))
(s (buffer-substring beg end)))
(dbg-msgbox s) ; やりたい処理
(forward-line)))
とかやっていた。
すごく冗長に感じていたし、カーソルを動かしたりするのがやるせなかった。行頭と行末のポイントが欲しいだけなのに、save-excursion するのとか、不必要に let* 使うのもちょっと変だと思っていた。まあ、いろいろキモかった。
もうちょっと読みやすいのを考えてみた。今回はマクロで。
;;; バッファを1行ずつ処理する
;;; e.g. (loop-at-buffer (line)
;;; (dbg-msgbox line))
(defmacro loop-at-buffer ((var &optional buffer) &body body)
(let ((gbuf (gensym))
(gstream (gensym)))
`(let* ((,gbuf (cond ((null ,buffer) (selected-buffer))
((bufferp ,buffer) ,buffer)
(t (find-buffer ,buffer))))
(,gstream (if ,gbuf (make-buffer-stream ,gbuf)
(error "\"~A\"という名前のバッファが見つかりません" ,buffer))))
(loop
(let ((,var (read-line ,gstream nil)))
(unless ,var (return nil))
,@body)))))
これを使うと、上の例は↓こう書けるようになる。
(loop-at-buffer (line)
(dbg-msgbox line))
わりといい感じになった。
パラメータは下記の2つ。
ちなみに、マクロ内で使ってる make-buffer-stream は xyzzy の関数なんだが、引数に nil を渡すと適当になんかのバッファ(selected-buffer か?)に紐づいたストリームを返すみたいで、具合が悪い。その対策を入れてある。
･･･とここまでやっておいて、実は with-input-from-buffer があったことに気づく。
また車輪やってしまった。
