/*
* Scm_Write - Standard Write.
*/
void Scm_Write(ScmObj obj, ScmObj p, int mode)
{
if (!SCM_OPORTP(p)) Scm_Error("output port required, but got %S", p);
ScmPort *port = SCM_PORT(p);
ScmWriteContext ctx;
write_context_init(&ctx, mode, 0, 0);
ScmVM *vm = Scm_VM();
if (PORT_LOCK_OWNER_P(port, vm) && PORT_RECURSIVE_P(port)) {
/* Special treatment - if we're "display"-ing a string, we'll bypass
walk path even if we're in the middle of write/ss. Using srfi-38
notation to show displayed strings doesn't make sense at all.
*/
if (PORT_WALKER_P(port) &&
!((mode == SCM_WRITE_DISPLAY) && SCM_STRINGP(obj))) {
write_walk(obj, port);
} else {
write_rec(obj, port, &ctx);
}
return;
}
PORT_LOCK(port, vm);
if (WRITER_NEED_2PASS(&ctx)) {
PORT_SAFE_CALL(port, write_ss(obj, port, &ctx),
cleanup_port_write_state(port));
} else {
PORT_SAFE_CALL(port, write_rec(obj, port, &ctx), /*no cleanup*/);
}
PORT_UNLOCK(port);
}
/* Default method for write-object */
static ScmObj write_object_fallback(ScmObj *args, int nargs, ScmGeneric *gf)
{
if (nargs != 2 || (nargs == 2 && !SCM_OPORTP(args[1]))) {
Scm_Error("No applicable method for write-object with %S",
Scm_ArrayToList(args, nargs));
}
ScmClass *klass = Scm_ClassOf(args[0]);
Scm_Printf(SCM_PORT(args[1]), "#<%A%s%p>",
klass->name,
(SCM_FALSEP(klass->redefined)? " " : ":redefined "),
args[0]);
return SCM_TRUE;
}
/*
* Scm_WriteWithControls - the general entry
*/
void Scm_WriteWithControls(ScmObj obj, ScmObj p, int mode,
const ScmWriteControls *ctrl)
{
if (!SCM_OPORTP(p)) Scm_Error("output port required, but got %S", p);
ScmPort *port = SCM_PORT(p);
ScmVM *vm = Scm_VM();
if (ctrl == NULL) ctrl = Scm_DefaultWriteControls();
if (PORT_LOCK_OWNER_P(port, vm) && PORT_RECURSIVE_P(port)) {
/* We're in the recursive call, so we just recurse into write_walk
or write_rec, according to the phase. NB: The controls passed
into the argument CTRL is ignored; the "root" control, passed
to the toplevel write API, will be used. */
if (PORT_WALKER_P(port)) {
/* Special treatment - if we're "display"-ing a string, we'll
bypass walk path even if we're in the middle of write/ss.
Using srfi-38 notation to show displayed strings doesn't
make sense at all. */
if (!((mode == SCM_WRITE_DISPLAY) && SCM_STRINGP(obj))) {
write_walk(obj, port);
}
} else {
ScmWriteContext ctx;
write_context_init(&ctx, mode, 0, 0);
write_rec(obj, port, &ctx);
}
} else {
/* We're in the toplevel call.*/
ScmWriteContext ctx;
write_context_init(&ctx, mode, 0, 0);
PORT_LOCK(port, vm);
if (WRITER_NEED_2PASS(&ctx)) {
ctx.controls = ctrl;
PORT_SAFE_CALL(port, write_ss(obj, port, &ctx),
cleanup_port_write_state(port));
} else {
/* write-simple case. CTRL is ignored. */
PORT_SAFE_CALL(port, write_rec(obj, port, &ctx), /*no cleanup*/);
}
PORT_UNLOCK(port);
}
}
/*
* Scm_WriteLimited - Write to limited length.
*
* Characters exceeding WIDTH are truncated.
* If the output fits within WIDTH, # of characters actually written
* is returned. Othewise, -1 is returned.
*
* Currently this API is only used from Scm_Printf, for 'format' has been
* moved to libfmt.scm. I don't like the way this is implemented and would
* like to share this with libfmt.scm eventually.
*/
int Scm_WriteLimited(ScmObj obj, ScmObj p, int mode, int width)
{
if (!SCM_OPORTP(p)) {
Scm_Error("output port required, but got %S", p);
}
ScmPort *port = SCM_PORT(p);
/* The walk pass does not produce any output, so we don't bother to
create an intermediate string port. */
if (PORT_LOCK_OWNER_P(port, Scm_VM()) && PORT_WALKER_P(port)) {
SCM_ASSERT(PORT_RECURSIVE_P(port));
write_walk(obj, port);
return 0; /* doesn't really matter */
}
ScmObj out = Scm_MakeOutputStringPort(TRUE);
SCM_PORT(out)->writeState = SCM_PORT(port)->writeState;
ScmWriteContext ctx;
write_context_init(&ctx, mode, 0, width);
/* We don't need to lock 'out', nor clean it up, for it is private. */
/* This part is a bit confusing - we only need to call write_ss
if we're at the toplevel call. */
if (PORT_RECURSIVE_P(SCM_PORT(port))) {
write_rec(obj, SCM_PORT(out), &ctx);
} else if (WRITER_NEED_2PASS(&ctx)) {
write_ss(obj, SCM_PORT(out), &ctx);
} else {
write_rec(obj, SCM_PORT(out), &ctx);
}
ScmString *str = SCM_STRING(Scm_GetOutputString(SCM_PORT(out), 0));
int nc = SCM_STRING_BODY_LENGTH(SCM_STRING_BODY(str));
if (nc > width) {
ScmObj sub = Scm_Substring(str, 0, width, FALSE);
SCM_PUTS(sub, port); /* this locks port */
return -1;
} else {
SCM_PUTS(str, port); /* this locks port */
return nc;
}
}
ScmObj Scm_MakeOutputConversionPort(ScmPort *toPort,
const char *toCode,
const char *fromCode,
int bufsiz, int ownerp)
{
if (!SCM_OPORTP(toPort))
Scm_Error("output port required, but got %S", toPort);
if (bufsiz <= 0) bufsiz = DEFAULT_CONVERSION_BUFFER_SIZE;
if (bufsiz <= MINIMUM_CONVERSION_BUFFER_SIZE) {
bufsiz = MINIMUM_CONVERSION_BUFFER_SIZE;
}
ScmConvInfo *cinfo = jconv_open(toCode, fromCode);
if (cinfo == NULL) {
Scm_Error("conversion from code %s to code %s is not supported",
fromCode, toCode);
}
cinfo->remote = toPort;
cinfo->ownerp = ownerp;
cinfo->bufsiz = (bufsiz > 0)? bufsiz : DEFAULT_CONVERSION_BUFFER_SIZE;
cinfo->remoteClosed = FALSE;
cinfo->buf = SCM_NEW_ATOMIC2(char *, cinfo->bufsiz);
cinfo->ptr = cinfo->buf;
ScmPortBuffer bufrec;
memset(&bufrec, 0, sizeof(bufrec));
bufrec.size = cinfo->bufsiz;
bufrec.buffer = SCM_NEW_ATOMIC2(char *, cinfo->bufsiz);
bufrec.mode = SCM_PORT_BUFFER_FULL;
bufrec.filler = NULL;
bufrec.flusher = conv_output_flusher;
bufrec.closer = conv_output_closer;
bufrec.ready = conv_ready;
bufrec.filenum = conv_fileno;
bufrec.data = (void*)cinfo;
ScmObj name = conv_name(SCM_PORT_OUTPUT, toPort, fromCode, toCode);
return Scm_MakeBufferedPort(SCM_CLASS_PORT, name, SCM_PORT_OUTPUT, TRUE, &bufrec);
}
