Exemplo n.º 1
0
/*
 * 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);
}
Exemplo n.º 2
0
/*
 * 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);
    }
}
Exemplo n.º 3
0
/*
 * 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;
    }
}