[uim-commit] r3051 - branches/r5rs/sigscheme/src

[yamaken at freedesktop.org]

Author: yamaken
Date: 2006-01-31 16:06:14 -0800 (Tue, 31 Jan 2006)
New Revision: 3051

Modified:
   branches/r5rs/sigscheme/src/error.c
   branches/r5rs/sigscheme/src/sigschemeinternal.h
   branches/r5rs/sigscheme/src/write.c
Log:
* sigscheme/src/sigschemeinternal.h
  - (scm_display_errobj_ss): New function decl
* sigscheme/src/error.c
  - (scm_p_inspect_error): Add shared structure handling for err_obj
* sigscheme/src/write.c
  - (write_ss_internal): New static function copied from scm_write_ss()
  - (scm_write_ss): Reform to wrapper to write_ss_internal()
  - (scm_display_errobj_ss): New function
  - (write_internal): Moved scm_port_flush() from write_obj()
  - (write_obj): Move scm_port_flush() to write_internal()


Modified: branches/r5rs/sigscheme/src/error.c
===================================================================
--- branches/r5rs/sigscheme/src/error.c	2006-01-31 23:24:25 UTC (rev 3050)
+++ branches/r5rs/sigscheme/src/error.c	2006-02-01 00:06:14 UTC (rev 3051)
@@ -275,11 +275,15 @@
     if (scm_debug_categories() & SCM_DBG_ERRMSG) {
         scm_port_printf(scm_err, SCM_ERR_HEADER);
         if (ERROBJP(err_obj)) {
+#if SCM_USE_SRFI38
+            scm_display_errobj_ss(scm_err, err_obj);
+#else
             scm_display(scm_err, err_obj);
+#endif
         } else {
             scm_port_puts(scm_err, SCM_ERRMSG_UNHANDLED_EXCEPTION);
             scm_port_puts(scm_err, ": ");
-            scm_write(scm_err, err_obj);
+            SCM_WRITE_SS(scm_err, err_obj);
         }
         scm_port_newline(scm_err);
     }

Modified: branches/r5rs/sigscheme/src/sigschemeinternal.h
===================================================================
--- branches/r5rs/sigscheme/src/sigschemeinternal.h	2006-01-31 23:24:25 UTC (rev 3050)
+++ branches/r5rs/sigscheme/src/sigschemeinternal.h	2006-02-01 00:06:14 UTC (rev 3051)
@@ -543,6 +543,9 @@
 ScmObj scm_prepare_port(ScmObj args, ScmObj default_port);
 ScmCharPort *scm_make_char_port(ScmBytePort *bport);
 
+/* write.c */
+void scm_display_errobj_ss(ScmObj port, ScmObj errobj);
+
 /* module.c */
 void scm_init_module(void);
 

Modified: branches/r5rs/sigscheme/src/write.c
===================================================================
--- branches/r5rs/sigscheme/src/write.c	2006-01-31 23:24:25 UTC (rev 3050)
+++ branches/r5rs/sigscheme/src/write.c	2006-02-01 00:06:14 UTC (rev 3051)
@@ -121,6 +121,7 @@
 static hash_entry *hash_lookup(hash_table *tab, ScmObj key, int datum, int flag);
 static void write_ss_scan(ScmObj obj, write_ss_context *ctx);
 static int  get_shared_index(ScmObj obj);
+static void write_ss_internal(ScmObj port, ScmObj obj, enum OutputType otype);
 #endif /* SCM_USE_SRFI38 */
 
 /*=======================================
@@ -149,6 +150,7 @@
         ERR("output port is required");
 
     write_obj(port, obj, otype);
+    scm_port_flush(port);
 }
 
 static void
@@ -238,7 +240,6 @@
     default:
         SCM_ASSERT(scm_false);
     }
-    scm_port_flush(port);
 }
 
 static void
@@ -647,9 +648,8 @@
     return 0;
 }
 
-/* write with shared structure */
-void
-scm_write_ss(ScmObj port, ScmObj obj)
+static void
+write_ss_internal(ScmObj port, ScmObj obj, enum OutputType otype)
 {
     write_ss_context ctx = {{0}};
     unsigned int i;
@@ -667,11 +667,24 @@
     if (!HASH_EMPTY(ctx.seen))
         write_ss_ctx = &ctx;
 
-    scm_write(port, obj);
+    write_internal(port, obj, otype);
 
     write_ss_ctx = NULL;
     free(ctx.seen.ents);
 }
+
+/* write with shared structure */
+void
+scm_write_ss(ScmObj port, ScmObj obj)
+{
+    write_ss_internal(port, obj, AS_WRITE);
+}
+
+void
+scm_display_errobj_ss(ScmObj port, ScmObj errobj)
+{
+    write_ss_internal(port, errobj, AS_DISPLAY);
+}
 #endif /* SCM_USE_SRFI38 */
 
 /*===========================================================================