structure の print-function (2)

なんか xyzzy のソースいぢって structure を ~S で format したときも print-function 呼ぶようにしてしまった。

closette を byte-compile すると落ちるのを調べるのに デバッグ用のxyzzyにアタッチして、ステップ実行 してみたんだけど、VS の使い方がよくわからないので書いてあった通りに Format::process でブレークして遊んでたら structure を出力すると思しき関数を見つけた。
CLHS 見てみたら、~S は基本的に readable な出力をするように となってるけど、structure の print-function で変更可能と書いてあった。

で、そうしてみた。

% git diff
diff --git a/src/lprint.cc b/src/lprint.cc
index 7959456..2da2d87 100755
--- a/src/lprint.cc
+++ b/src/lprint.cc
@@ -1411,7 +1411,13 @@ print_struct_data (wStream &stream, const print_control &pc,
   int condp = (Fsi_structure_subtypep (def, xsymbol_value (QCcondition)) != Qnil
                && xstrdef_report (def) != Qnil);

-  if (pc.readably || pc.escape
+  if (xstrdef_print_function (def) != Qnil && !condp)
+    {
+      wstream_stream w (stream);
+      funcall_3 (xstrdef_print_function (def), object,
+                 xsymbol_value (Vwstream_stream), make_fixnum (level));
+    }
+  else if (pc.readably || pc.escape
       || (xstrdef_print_function (def) == Qnil && !condp))
     {
       stream.add ("#S(");

print-function があったら(コンディションじゃなければ)呼ぶようにしたので、*print-nantoka* を自分でケアしなきゃいけなくなったけど、強制 #S notation の方が困るのでいいことにする。いちいち #S notation 作るのはめんどいので関数作っといた。`#S(name :key ...)` と "key" じゃなくて ":key" になるけど、これでも読める&個人的に見やすいのでこうしといた。

(defun print-structure-readably (obj strm n)
  (let ((def (si:*structure-definition obj)))
    (format strm "#S(~S" (si:*structure-definition-name def))
    (dotimes (i (si:*structure-definition-nslots def))
      (format strm " ~S ~S"
              (si:*structure-definition-slot-description def i)
              (si:*index-slot-value obj i)))
    (format strm ")")))