[xyzzy] C-x a で変数をセットするやつ
2014-10-19
* バッファローカルな変数をちゃんとセットできてなかったのを修正
* 標準の関数上書きするのをやめた
主に lisp 書いてて *buffer-package* を修正するのに使ってる。けど微妙に使いにくいので余計なことをしてみた。
- 値を入力するときに元の値と（あれば）変数の説明を表示
- 元の値が文字列だったときに、文字列を入力させるか否かを設定できるように
- 値を入力するときのプロンプトを文字列待ちなら変える
(defvar *set-variable-for-string* t "*コマンド set-variable で変数の値が文字列の場合、式ではなく文字列を入力するかどうか。") (defun my-set-variable (var) (interactive "vSet variable: ") (unless (and (symbolp var) (boundp var)) (error "No such variable")) (set var (save-window-excursion (save-excursion ;; 変数の説明があれば *Help* バッファに表示 (let ((buf (get-buffer-create "*Help*")) (doc (documentation var 'variable)) (val (symbol-value var))) (erase-buffer buf) (setup-temp-buffer buf) (with-output-to-buffer (buf) (when doc (format t "変数の説明:~%~A~2&" doc)) (format t "元の値:~%~S~2%" val)) (pop-to-buffer buf) (if (and *set-variable-for-string* (stringp val)) (read-string "文字列: ") (read-sexp "値: "))))))) (global-set-key '(#\C-x #\a) 'my-set-variable)
defcustom があれば色々できるんだろうけどなー。
昨日の日記を今日書く人なので
via 前後の日付を挿入 - 象徴ヶ淵
前置引数で数を指定した場合はその文前後にずらすでいいけど、夜寝てしまったとかで昨日の日記を書く事が多々あるので -1 を指定したいことが多い。けど C-u - 1 F5 とかめんどいので C-u F5 は昨日の日付にしてみた。
(defvar *date-string* "%Y-%m-%d") (defun insert-date (&optional arg) "時刻を挿入。" (interactive "*P") (let ((date (+ (get-universal-time) (* (case arg ((nil) 0) (digit-argument *prefix-value*) (universal-argument -1)) 86400)))) (insert (format-date-string *date-string* date)))) (global-set-key #\F5 'insert-date)
日記は Evernote に書いてるから使えないんだけどな。
パッケージ名をキーワードで書く理由
一言で言うと: xyzzy でも CL でも同じように書けるから
文字列で書くと...
xyzzy でも CL でも文字列は大文字/小文字の変換などされないので、小文字はそのまま扱われる。defpackage でパッケージ名を文字列で書くと、パッケージ名に小文字を含んだパッケージが定義される。
これが CL では実質的に使い物にならない。そのままではシンボル名に小文字を含めることができないので、文字列で指定するかエスケープする必要がある。
;; CCL (SLIME) にて CL-USER> (defpackage "foo" (:use :cl) (:export #:hello)) #<package: "foo"> CL-USER> (find-package 'foo) NIL CL-USER> (symbol-package 'foo:hello) ; Evaluation aborted on #<CCL::NO-SUCH-PACKAGE #x189B61E6> CL-USER> (symbol-package '|foo|:hello) #<package: "foo">
（キーワード以外の）シンボルで書くと...
xyzzy ではパッケージ名もシンボル名も小文字のままなので問題なし。
CL ではパッケージ名もシンボル名も大文字に変換されるので問題なし。
てなわけで xyzzy でも CL でも大文字/小文字の問題でパッケージが見つけられないってことにはならないんだけど、xyzzy の in-package が CL と違って引数を評価してしまうので、xyzzy ではクォートする必要がある。
;; xyzzy (xl-repl) にて user> :expand (in-package foo) (eval-when (:compile-toplevel :load-toplevel :execute) (lisp::in-package-1 foo))
lisp::in-package-1 は関数なので foo が評価される（setq とかしてなければエラーになる）
CL では評価されない。
Arguments and Values:
name---a string designator; not evaluated.
CLHS: Macro IN-PACKAGE
キーワードで書けば
シンボルと同じく大文字/小文字の問題もなく、in-package でも自分自身に評価されてちゃんと指定できる。
難点を言えば、defpackage がキーワードまみれになるので regexp-keyword-list で色付けてるのにちゃんと見ないと区別できない。
まとめ
CL と行ったり来たりするんでなければ文字列で問題無かった。
main-loop と {exit,quit}-recursive-edit
昔見つけたのをちょいと調べてみた。
main-loop
呼び出すと、現在実行中の処理をポーズしたまま xyzzy が操作を受け付けるようになる。ミニバッファに突入しない read-string みたいな感じ。
{exit,quit}-recursive-edit
main-loop のポーズを解除して元の処理を再開する。exit-recursive-edit は引数の値を (main-loop) の戻り値として元の処理の方に渡せる。ただし多値は使えない。quit-recursive-edit は引数を受け付けるものの行方不明になってしまう。
制限
使うと色々面白いことができそうだけど、何度も (main-loop) すると実行途中でポーズされた処理がスタックしていくので、最期にポーズした処理からしか再開できない。
試してみる
最初の (let ...) を評価すると "1: before main-loop..." が出力されたところで操作できるようになるので、下に移動して (exit-recursive-edit :hello) すると "2: main-loop returned..." と "3: after main-loop..." が出力される。
(let ((x 3)) (format t "1: before main-loop: ~S~%" x) (format t "2: main-loop returned:~% => ~S~%" (main-loop)) (format t "3: after main-loop: ~S~%" x)) 1: before main-loop: 3 2: main-loop returned: => :hello 3: after main-loop: 3 (exit-recursive-edit :hello) => nil
exit-recursive-edit すると lisp の処理は元の処理に戻るけど、エディタの状態（現在のバッファとかカーソル位置とか）は元に戻らないみたい。
ansify 0.03.00 微妙に更新
大したものは実装してないんですが一区切りしたい気分だったのでリリースしておきます。
変更点
- 一部の型指定子をグローバルに修正するようにした
- xl-alexandria の `positive-real` 型などの問題が解消されるはず
- `(defun (setf READER) ...)` あたりを使えるように
- `sleep` 追加（中身は `ed:sleep-for`）
いつもの
- NetInstaller 用 packages.l
- 手動ダウンロード用 ansify-0.03.00.zip
jaunte 0.00.01
Good night, Posterous の画像や説明を見て何となく実装してみました。たぶん大体似てる。
前回までのあらすじ
hit-a-hint って確か Firefox の拡張だったと思うのだけど何故か Emacs に移植されてるみたい。
id:miyamuko さんが挑戦するも･･･
;; とやろうとしたけど、2 の段階で キーワードの色が付かなくなることに気づいてやめた。
hit-a-hint を #xyzzy でつくろうとして挫折した記録。 · GitHub
;; "(defun hoge" を "[1]fun hoge" にすると defun の色が消える。
その後も苦労は続くのであった。
http://meganemusume.net/2011/10/11/xyzzy-jaunt/
で jaunte ってなに
jaunte を実行すると画面内のあちらこちらにジャンプ先となるヒントが表示されます。同時にミニバッファで入力待ちになるので、ジャンプしたいところのヒントを入力するとそこへ移動できます。
キーワードの色をどう解決したか
xyzzy だとバッファ上にヒントを表示するには実際にバッファの内容を書き換える必要があって、そうするとどうしてもキーワードのみならず syntax 依存の色付け全部は壊れてしまう。正直どうにもなんない。
で色々調べてて Vim の EasyMotion という plugin の ビデオ を見てたら、「あれ、これ色付けなくていんじゃね？」ということになったので、（ヒント以外は）色は付きません。
インストール方法とか
README 参照。
いつもの
- NetInstaller 用 packages.l
- 手動ダウンロード用 jaunte-0.00.01.zip
ロカール関数で (setf READER) を諦めた記録
CL だとこんなことができる。
;; Clozure CL での例 CL-USER> (let ((table (make-hash-table))) (labels ((key (key) (gethash key table)) ((setf key) (value key) (setf (gethash key table) value))) (setf (key 1) "foo" (key 2) "bar") (maphash (lambda (k v) (format t "~S -> ~S~%" k v)) table) (values (key 1) (key 2)))) 2 -> "bar" 1 -> "foo" "foo" "bar"
(setf (key X) VALUE) を正しく展開できるようにするにはこんなのがあればいい。
(defun |(setf key)| (value key) (setf (gethash key table) value)) => |(setf key)| (define-setf-method key (&rest sub-forms) (values (list '#1=#:args) (list `(list ,@sub-forms)) (list '#2=#:new-value) `(apply '|(setf key)| #2# #1#) `(apply 'key #2#))) => (setf key) (macroexpand '(setf (key X) VALUE)) => (let* ((#1=#:args (list X)) (#2=#:new-value VALUE)) (apply '|(setf key)| #2# #1#)) => t
define-setf-method で定義した setf-expander はプロパティ lisp::setf-method にある。
(get 'key 'lisp::setf-method) => #<lexical-closure: (anonymous)> (si:closure-body *) => (lambda (#:G225 &rest sub-forms) (values (list '#1=#:args) (list (cons 'list sub-forms)) (list '#2=#:new-value) '(apply '|(setf key)| #2# #1#) '(apply 'key #2#)))
labels の BODY 部分で setf を（macrolet で）置き換えて、展開する時に一時的にプロパティ lisp::setf-method に setf-expander を突っ込んでやる。のだが展開できない。
(remprop 'x 'lisp::setf-method) => nil ;; 展開前の式 (let ((table (make-hash-table))) (labels ((key (key) (gethash key table)) ((setf key) (value key) (setf (gethash key table) value))) (setf (key 1) "foo" (key 2) "bar") (maphash (lambda (k v) (format t "~S -> ~S~%" k v)) table) (values (key 1) (key 2)))) ;; 手動ででっちあげた展開形 (let ((table (make-hash-table))) (labels ((key (key) (gethash key table)) (|(setf key)| (value key) (setf (gethash key table) value))) (macrolet ((setf (&environment env &rest args) (let ((ovals nil) (expander (lambda (#:env &rest sub-forms) (values (list '#1=#:args) (list `(list ,@sub-forms)) (list '#2=#:new-value) `(apply #'|(setf key)| #2# #1#) `(apply 'key #2#))))) (unwind-protect (progn (push (cons 'key (get 'key 'lisp::setf-method '#0=#:unbound)) ovals) (si:*putprop 'key expander 'lisp::setf-method) ;; lisp/setf.l より (cond ((endp args) nil) ((endp (cdr args)) (error "~S: 不正なsetfフォームです" args)) ((endp (cddr args)) (lisp::setf-expand-1 (car args) (cadr args) env)) (t (cons 'progn (lisp::setf-expand args env))))) (let ((oval (cdr (assoc 'key ovals)))) (if (eq oval '#0#) (remprop 'key 'lisp::setf-method) (si:*putprop 'key oval 'lisp::setf-method))))))) (setf (key 1) "foo" (key 2) "bar") (maphash (lambda (k v) (format t "~S -> ~S~%" k v)) table) (values (key 1) (key 2))))) ; Evaluation aborted on `simple-error' ; (key 1)のsetfメソッドはありません
でどこでエラーになるのか調べたら get-setf-method-multiple-value でローカルな（関数｜マクロ）だったらマクロ展開できなきゃいかん事になってる。
;; lisp/setf.l より (defun get-setf-method-multiple-value (form &optional env) (let (tem) (cond ; ...(snip)... ((si:*find-in-environment form env) ;(setq tem (assoc (car form) env)) (setq tem (macroexpand-1 form env)) (if (eq tem form) (error "~Sのsetfメソッドはありません" form)) (get-setf-method-multiple-value tem env)) ; ...(snip)... )))
ここまでやって諦めた。
ローカルな setf で展開する時に一時的に get-setf-method-multiple-value の定義を入れ替えてやれば何とかなるような気がするけど、疲れたので記録だけ残して放置。
