summaryrefslogtreecommitdiff
path: root/libguile/struct.c
diff options
context:
space:
mode:
authorMarius Vollmer <mvo@zagadka.de>1997-06-04 22:40:58 +0000
committerMarius Vollmer <mvo@zagadka.de>1997-06-04 22:40:58 +0000
commit916d65b1d12623e89d84c2be2536bc7a2e372d53 (patch)
tree4e8370fb6d8f0b61fac3d2b1a50e95fb58d4f94d /libguile/struct.c
parentfa7e92746642ed139eaad0250d3c2a953bcd32dc (diff)
downloadguile-916d65b1d12623e89d84c2be2536bc7a2e372d53.tar.gz
* struct.c (struct_printer): New variable that holds a handle on
the Scheme variable *struct-printer*. This variable can be set by Scheme code to override the printing of structures. (scm_print_struct): If struct_printer is set, call it. If it is not set, or returns #f, print the structure in the old fashion. Include "eval.h" for scm_apply.
Diffstat (limited to 'libguile/struct.c')
-rw-r--r--libguile/struct.c38
1 files changed, 11 insertions, 27 deletions
diff --git a/libguile/struct.c b/libguile/struct.c
index 6f2261ec5..4c437e29a 100644
--- a/libguile/struct.c
+++ b/libguile/struct.c
@@ -44,6 +44,7 @@
#include "_scm.h"
#include "chars.h"
#include "genio.h"
+#include "eval.h"
#include "struct.h"
@@ -55,6 +56,7 @@
static SCM required_vtable_fields = SCM_BOOL_F;
static int struct_num = 0;
+static SCM struct_printer_var;
SCM_PROC (s_struct_make_layout, "make-struct-layout", 1, 0, 0, scm_make_struct_layout);
@@ -196,7 +198,7 @@ init_struct (handle, tail_elts, inits)
case 'p':
if ((prot != 'r' && prot != 'w') || inits == SCM_EOL)
- *mem = SCM_EOL;
+ *mem = SCM_BOOL_F;
else
{
*mem = SCM_CAR (inits);
@@ -602,34 +604,15 @@ scm_print_struct (exp, port, pstate)
SCM port;
scm_print_state *pstate;
{
-#if 0 /* XXX - too verbose */
- SCM * data;
- SCM layout;
- int p;
- int n_fields;
- unsigned char * fields_desc;
- unsigned char field_type;
-
- layout = SCM_STRUCT_LAYOUT (exp);
- data = SCM_STRUCT_DATA (exp);
-
- fields_desc = (unsigned char *)SCM_CHARS (layout);
- n_fields = data[scm_struct_i_n_words] - scm_struct_n_extra_words;
-
- scm_gen_write (scm_regular_string, "#<struct ", sizeof ("#<struct ") - 1, port);
- for (p = 0; p < n_fields; p++)
+ SCM prt = SCM_CDR (struct_printer_var);
+ if (SCM_FALSEP(prt) ||
+ SCM_FALSEP(scm_apply (prt, exp, scm_cons (port, scm_listofnull))))
{
- if (fields_desc[2*p] == 'p')
- scm_iprin1 (data[p], port, pstate);
- if (p < n_fields-1)
- scm_gen_putc (' ', port);
+ scm_gen_write (scm_regular_string, "#<struct ", sizeof ("#<struct ") - 1,
+ port);
+ scm_intprint (exp, 16, port);
+ scm_gen_putc ('>', port);
}
- scm_gen_putc ('>', port);
-#else
- scm_gen_write (scm_regular_string, "#<struct ", sizeof ("#<struct ") - 1, port);
- scm_intprint (exp, 16, port);
- scm_gen_putc ('>', port);
-#endif
}
void
@@ -638,6 +621,7 @@ scm_init_struct ()
required_vtable_fields = SCM_CAR (scm_intern_obarray ("pruosr", sizeof ("pruosr") - 1, SCM_BOOL_F));
scm_permanent_object (required_vtable_fields);
scm_sysintern ("struct-vtable-offset", SCM_MAKINUM (scm_struct_i_vtable_offset));
+ struct_printer_var = scm_sysintern("*struct-printer*", SCM_BOOL_F);
#include "struct.x"
}