プロジェクトの site-lisp を *load-path* に追加する

xyzzy の拡張書くときは ~/work/<プロジェクト名> にこんな風にファイルが配置される。

  • ~/work/<プロジェクト名>/
    • README.md
    • site-lisp/
      • <プロジェクト名>.l
      • <プロジェクト名>/
        • packages.l
        • util.l
        • ...

最初は <プロジェクト名>.l に全部書いてるんだけど、何度も書いては捨ててるうちに毎回書くもの(パッケージ定義とかユーティリティとかある程度形が決まってきたものとか)を別ファイルに分割していくので、この時点では主に <プロジェクト名>.l で色々やってる。

~/work/<プロジェクト名>/site-lisp/*load-path* に追加される形を想定しているので、各ファイルのモジュール名はこうなる。

  • ~/work/<プロジェクト名>/site-lisp/<プロジェクト名>.l
    • --> "<プロジェクト名>"
  • ~/work/<プロジェクト名>/site-lisp/<プロジェクト名>/packages.l
    • --> "<プロジェクト名>/packages"
  • ~/work/<プロジェクト名>/site-lisp/<プロジェクト名>/util.l
    • --> "<プロジェクト名>/util"

なので <プロジェクト名>.l から他のファイルを require している。

(eval-when (:execute :compile-toplevel :load-toplevel)
  (require "<プロジェクト名>/packages.l")
  (require "<プロジェクト名>/util.l")
  ...)

諸々の事情(Windows Update など)で xyzzy を再起動したりした時には、~/work/<プロジェクト名>/*load-path* に登録されていないので、こいつらを見つけられなくなって、全部のファイルを順番に手動でロードしたり repl から手動で *load-path* に追加したりしてたんだけど、めんどくなったので勝手に *load-path* へ追加するようにした。

(in-package :editor)

(defun provide-module-name ()
  (save-excursion
    (goto-char (point-min))
    (when (scan-buffer "^(provide \"\\([^\"]+\\)" :regexp t)
      (format nil "~A.l" (match-string 1)))))

(defun module-root-pathname (pathname module-name)
  (let ((path (reverse (split-string pathname "/")))
        (name (reverse (split-string module-name "/"))))
    (while name
      (unless (string= (car path) (car name))
        (error "モジュール名とファイル名が一致しません: ~S" module-name))
      (setf path (cdr path)
            name (cdr name)))
    (format nil "~{~A/~}" (reverse path))))

(defun add-module-root-to-load-path ()
  (let ((root (module-root-pathname (get-buffer-file-name) (provide-module-name))))
    (pushnew root *load-path* :test #'path-equal)))

(defconstant +original-require-function+ #'require)

(defun require (module-name &optional pathname)
  (handler-case
      (funcall +original-require-function+ module-name pathname)
    (error (e)
      (if (and (typep e 'simple-error)
               (string= (princ-to-string (simple-error-format-string e))
                        "ファイルが見つかりません"))
        (progn
          (add-module-root-to-load-path)
          (funcall +original-require-function+ module-name pathname))
        (error e)))))

今編集してる lisp ファイルを保存したときに(コンパイルして)ロードしてるので、現在のバッファでモジュール名とか探してる。他のところからロードしたときは使えねーわ。

特定の場合のみ違うことをするコマンドを作る

たとえば C-k (kill-line) は普通、現在位置から行末を kill して改行が残るんだけど、行頭でやったら改行も含めて kill する(1行まるっと kill)にしたい。という場合。

よくあるやり方は、そういうコマンドを作って置き換えるパターン。xyzzyの音 - 編集 にあるようなの。

今回これとはちょっと違うやり方をやりたかったので、ごちゃごちゃやってみた。

  • いくつかのキーで特定の場合に違うことをさせたい。
  • 複数のモードで使いたい。
  • 特定の場合以外では、普通に動いてて欲しい。

という感じ。

まず minor-mode を作る。

;;;; Keymap

(defvar *hoge-mode-keymap* nil)

(unless *hoge-mode-keymap*
  (let ((kmap (make-sparse-keymap)))
    (define-key #\C-k 'kill-whole-line-or-original)
    (setf *hoge-mode-keymap* kmap)))


;;;; Minor mode

(defvar-local hoge-mode nil)

(defun hoge-mode (&optional (arg nil sv))
  (interactive "p")
  (ed::toggle-mode 'hoge-mode arg sv)
  (if 'hoge-mode
    (set-minor-mode-map *hoge-mode-keymap*)
    (unset-minor-mode-map *hoge-mode-keymap*))
  (update-mode-line t))
(pushnew '(hoge-mode . "Hoge") *minor-mode-alist* :key #'car)

マイナーモードのキーマップを使うだけ。そのキーマップは C-kkill-whole-line-or-original というコマンドを割り当ててるだけ。

んで、コマンドがこんなの。

(defun kill-whole-line-or-original (&optional lines)
  (interactive "*p")
  (if (bolp)
    (let ((point (point))
          (lines (cond ((or (null lines)
                            (<= lines 1))
                         0)
                       (t
                         (- arg 1)))))
      (kill-region point
                   (progn
                     (forward-line lines)
                     (goto-eol)
                     (forward-char)
                     (point))))
    (call-interactively (original-command *last-command-char*))))

実装はxyzzyの音 - 編集 をパクらせてもらった。 要は (bolp) だったら行末まで kill してるのだが、(bolp) ではない場合に (call-interactively (original-command *last-command-char*)) とした。

original-command はこれから実装するので置いとくとして、*last-command-char* は押されたキーに束縛されてる。 なので、押されたキーが実行するはずだったコマンドを探して call-interactively すればいいんじゃね。というのが今回の作戦であり、original-command は指定されたキーが実行するはずだったコマンドを探す関数。

;;; Modified version of original `lookup-key-command`
(defun original-command (key)
  (let ((bound (mapcar #'(lambda (x)
                           (when (and (keymapp x)
                                      (not (eql x *hoge-mode-keymap*)))
                             (lookup-keymap x key)))
                       (append (list (current-selection-keymap))
                               (minor-mode-map)
                               (list (local-keymap))
                               (list *global-keymap*)))))
    (or (find-if-not #'keymapp bound)
        (find-if #'identity bound))))

もともと xyzzy には lookup-key-command という、現在のバッファで使用してるキーマップから指定されたキーのコマンドを探し出す関数があるのだけど、そのままだとマイナーモードで上書きしたコマンド自身(今回の例だと kill-whole-line-or-original)が返ってきて再帰呼び出しになってしまうので、マイナーモードのキーマップ(*hoge-mode-keymap*)を除外して探すようにしたのがこれ。

これで (bolp) でなかったときは (original-command *last-command-char*) が見つけた kill-linecall-interactively して、普通に kill-line される(はず)。

FIXME: たぶん複数キーストロークC-x f とか)に対応してない。

defvar で再定義

lisp を書いてると defvar の初期値を変更して読み込んでも値は変わらなくて、「めんどくせーな」とか言いながら repl から setf し直すハメになることがちょくちょくあるので、defvar で再定義したときに最初(前回)の初期値から変更されてなければ値を更新するようにした。
どれだか忘れたけど Common Lisp だか Emacs だかで同じファイルから再定義したときのみ更新するという話を聞いたことがあるような気がするけど、めんどいのと defvar を別ファイルに引っ越したいことがたまにあるのでそこは無視した。

間違って2度 defvar してたりすると不可思議なことになると思うので、lisp 書く人以外は使わない方がいいと思う。

(defmacro defvar (name &optional (init nil sv) doc)
  (let ((UNDEF '#:undef))
    `(labels ((%get (symbol indicator default)
                (do ((plist (symbol-plist symbol) (cddr plist)))
                    ((endp plist)
                     default)
                  (when (eql (car plist) indicator)
                    (return (cadr plist))))))
       ,(when sv
          `(let ((#1=#:value ,init))
             (when (or (not (boundp ',name))
                       (equal ,name (%get ',name 'lisp::variable-default-value ',UNDEF)))
               (set ',name #1#))
             (si:*putprop ',name #1# 'lisp::variable-default-value)))
       ,(when doc
          `(si:*putprop ',name ,doc 'lisp::variable-documentation))
       (si:*make-special ',name)
       ',name)))

Common Lisp で JavaScript の JSON.stringify?

Common LispでJavaScriptのJSON.stringify←→JSON.parseのようなことをする - @peccul is peccu

を見てちょっと気になったので。

乱暴に言うと Common Lisp の出力には2種類あって、正しい呼び方があるような気がするけど知らないので "PRINC出力" "PRIN1出力" と呼んでおく。

;; PRINC出力
* (format t "~A" '(:key "value"))
(key value)
=> nil
* (princ '(:key "value"))
(key value)
=> (:key "value")

;; PRIN1出力
* (format t "~S" '(:key "value"))
(:key "value")
=> nil
* (prin1 '(:key "value"))
(:key "value")
=> (:key "value")

format で出力する場合は "~S" でPRIN1出力、 "~A" でPRINC出力になる。
なにが違うかというと

prin1 produces output suitable for input to read. It binds *print-escape* to true.

princ is just like prin1 except that the output has no escape characters. It binds *print-escape* to false and *print-readably* to false. The general rule is that output from princ is intended to look good to people, while output from prin1 is intended to be acceptable to read.

CLHS: Function WRITE, PRIN1, PRINT, PPRINT...

PRIN1出力が READ で読み込めるような出力であるのに対し、PRINC出力は人間が読みやすいような出力。ということになってる。
その辺をもうちょっと深掘りすると、Common Lisp の printer は printer control variable と呼ばれる変数群でどのように出力するかをコントロールできるようになっていて、PRIN1出力やPRINC出力は前述の意図に沿った形で出力するようにそれらの変数を適切な値にして出力する

printer control variable の中に *print-readably* てのがあって、その名の通り non-nil であれば READ で読み込めるような出力をしなさい。無理ならエラー投げなさい。という変数。

If *print-readably* is true, some special rules for printing objects go into effect. Specifically, printing any object O1 produces a printed representation that, when seen by the Lisp reader while the standard readtable is in effect, will produce an object O2 that is similar to O1. (中略)If printing an object readably is not possible, an error of type print-not-readable is signaled rather than using a syntax (e.g., the ``#<'' syntax) that would not be readable by the same implementation.

CLHS: Variable *PRINT-READABLY*

なので read で読み込めるように出力するには *print-readably* を non-nil にして出力すれば良いということになる。
てっきりPRIN1出力する時は *print-readably* が non-nil になるものと思ってたので、PRIN1出力しとけば良いだろうと思ったのだけど、確認してみたらそうではなかった。

prin1 produces output suitable for input to read. It binds *print-escape* to true.

(中略)

Notes:

The functions prin1 and print do not bind *print-readably*.

CLHS: Function WRITE, PRIN1, PRINT, PPRINT...

なんだよそれ、中途半端なことしやがって・・・。

そいで *print-readably* を non-nil にすると具体的に何が変わるかというと、 #<...> みたいな出力されるもの。これは read に与えるとエラーになる。というか read できないもの用の表現

* (prin1 (make-hash-table))
#<hashtable :test eql :size 0/17 17764932>
=> #<hashtable :test eql :size 0/17 17764932>
* (read-from-string (prin1-to-string (make-hash-table)))
Line 1: ディスパッチングマクロ副文字ではありません: <
;; xyzzy で、リーダーマクロが定義されてないというエラー
;; 真っ当な Common Lisp 処理系だともうちょっと気の利いたエラーになりそう

どう出力されるかは処理系依存だけど、エラーになるか #.でどうにかするか、いずれにしろファイルに出力しておいたけど後で読み込もうとしたら読み込めなくてどーすんだよ!オマエ責任とれよ!みたいなことにはならないはず。

なので、最初に戻って JSON.stringify みたいなこと、というか読み込めるように出力したいのであればこうした方が良さそう。

(defun print-readably (object &optional out)
  (write object :stream out :readably t))

余談: print-object メソッドを自分で実装する人は *print-readably* が non-nil だったら read できるように出力するかエラー投げないといけないとのことなのでガンバレ。

Individual methods for print-object, including user-defined methods, are responsible for implementing these requirements.

CLHS: Variable *PRINT-READABLY*

めんどかったら print-unreadabl-object 使っておけば *print-readably* が non-nil だったらエラー投げてくれる。

Exceptional Situations:

If *print-readably* is true, print-unreadable-object signals an error of type print-not-readable without printing anything.

CLHS: Macro PRINT-UNREADABLE-OBJECT

キーワードテーブルが大文字小文字を区別するかどうか

結論: (hash-table-test <キーワードテーブル>) が equal なら区別する、equalp なら同一視する

(defun keyword-table-ignore-case-p (table)
  (eql (keyword-table-test table) 'equalp))

説明

キーワードテーブルは load-keyword-file でキーワードファイルを読み込むと作成されるハッシュテーブルで、load-keyword-file で引数 ICASE に non-nil を指定するとキーワードの大文字小文字を無視するようになる。らしい。のだが、具体的にどこが変わるかというと ${XYZZY}/lisp/kwd.l L.44 あたりにある

(defun make-keyword-table (&optional icase size)
  (make-hash-table :test (if icase #'equalp #'equal) :size size))

でハッシュテーブルの比較関数が変わる。
なので、ハッシュテーブルの比較関数を調べれば大文字小文字を区別するかを判断できる。

Yosemite + Karabiner で Dvorak の設定

とりあえず Windows で使ってたのと同程度に使えるようにしたかった。
その Windows で使ってた配列が困ったこと窓使いの憂鬱依存なのだけど、なんとかそれっぽい設定にできたのでメモ。

目標とする設定

  • 基本的な配列は Dvorak
  • Space が SandS
  • 左Ctrl が単独で押すと Escape
  • Space の右(Macbook では [かな] キー)が Enter
  • Space の左(Macbook では [英数] キー)が Backspace(Mac では [Delete])

Mac の Keyboard Preference での設定

Input Source タブ(?)で以下のを追加しとく

Karabiner の方でも Dvorak にすることができるみたいなんだけど、アルファベット以外のキーが俺の知ってる Dvorak と違ったりしたので、基本的な配列を Dvorak にするのはこっちでやることにした。

Karabiner の設定

※昔 keyremap4macbook とかいう名前だったやつ
残りの細かいのをこっちで設定する。

  • remapping
    • Change Control_L Key (Left Control)
      • Control_L to Control_L (+ When you type Control_L only, send Escape)
    • Change Space Key
      • SandS v2
  • For Japanese
    • 左右のコマンドキー(⌘)を「英数/かな」としても使う
      • コマンドキーの動作を優先モード v2
    • Change EISUU Key
      • EISUU to Delete
    • Change KANA Key
      • KANA to Return

感想

  • 物理的なキーボードの形状の問題で親指で押すキーが使いにくい
  • [英数][かな] を潰してしまったのでとりあえず Command キーにしてみたけどちょと押しにくい
  • ローマ字が DvorakJP じゃないのでカ行とかが・・・

lisp-mode で保存したら *buffer-package* を設定する

ファイルの先頭付近にあるアレ

;;; -*- mode: lisp; package: editor -*-

を見て、*buffer-package* を設定するやつ。*buffer-package* をちゃんとしておかないと ac-mode が上手く補完してくれないとかインデントがおかしいとか色々調子悪いんで。

;;;; Set *buffer-package* on save-buffer

(defun lisp-detect-buffer-package ()
  (cdr (assoc "package" (ed::find-file-scan-params) :test #'string-equal))
  ;; FIXME: (in-package :PACKAGE)
  )

(defun lisp-set-buffer-package ()
  (when (member buffer-mode '(lisp-mode
                              lisp-interaction-mode
                              ;lisp-repl-mode  ; save-buffer しねーだろ
                              ))
    (setf *buffer-package* (lisp-detect-buffer-package))))

(add-hook '*after-save-buffer-hook* 'lisp-set-buffer-package)