From bedbf6a6114caaf627caec6b030599871533791e Mon Sep 17 00:00:00 2001
From: Kaz Kylheku <kaz@kylheku.com>
Date: Wed, 1 Jun 2016 06:55:21 -0700
Subject: Print method on objects.

* struct.c (print_s): New symbol variable.
(struct_init): Initialize print_s.
(struct_inst_print): If pretty-printing, try to look
up object's print method and use it.

* txr.1: Documented pretty-printing via print method.
---
 struct.c | 11 ++++++++++-
 txr.1    |  8 ++++++++
 2 files changed, 18 insertions(+), 1 deletion(-)

diff --git a/struct.c b/struct.c
index 2318ee8b..21a3a18a 100644
--- a/struct.c
+++ b/struct.c
@@ -76,7 +76,7 @@ struct struct_inst {
   val slot[1];
 };
 
-val struct_type_s, meth_s;
+val struct_type_s, meth_s, print_s;
 
 static cnum struct_id_counter;
 static val struct_type_hash;
@@ -98,6 +98,7 @@ void struct_init(void)
           convert(val *, 0));
   struct_type_s = intern(lit("struct-type"), user_package);
   meth_s = intern(lit("meth"), user_package);
+  print_s = intern(lit("print"), user_package);
   struct_type_hash = make_hash(nil, nil, nil);
   slot_hash = make_hash(nil, nil, t);
   struct_type_finalize_f = func_n1(struct_type_finalize);
@@ -985,6 +986,14 @@ static void struct_inst_print(val obj, val out, val pretty)
                                        num_fast(indent_data));
   val save_indent, iter, once;
 
+  if (pretty) {
+    loc ptr = lookup_static_slot_load(st->self, st, print_s);
+    if (!nullocp(ptr)) {
+      funcall2(deref(ptr), obj, out);
+      return;
+    }
+  }
+
   put_string(lit("#S("), out);
   obj_print_impl(st->name, out, pretty);
   save_indent = inc_indent(out, one);
diff --git a/txr.1 b/txr.1
index 8d5906da..e79ec1d7 100644
--- a/txr.1
+++ b/txr.1
@@ -19280,6 +19280,14 @@ type whose instances have already been inserted as keys in an
 .code :equal-based
 hash table, searches for those keys will not work reliably.
 
+.NP* Custom Pretty-Printing
+
+If a method named by the symbol
+.code print
+is defined for a structure type, then it is used for pretty-printing instances
+of that type. The method takes one argument (in addition to the object), which
+specifies the output stream.
+
 .coNP Macro @ defstruct
 .synb
 .mets (defstruct >> { name | >> ( name << arg *)} < super
-- 
cgit v1.2.3