/* Symbol printer.
NB: Uninterned symbols are treated as sharable objects (can be written
with #n= syntax). It is handled by upper layer (write.c) so we don't
worry about it in this routine.
*/
static void symbol_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
if (Scm_WriteContextMode(ctx) == SCM_WRITE_DISPLAY) {
SCM_PUTS(SCM_SYMBOL_NAME(obj), port);
} else {
#if !GAUCHE_UNIFY_SYMBOL_KEYWORD
if (SCM_KEYWORDP(obj)) {
SCM_PUTC(':', port);
/* We basically print keyword names in the same way as symbols
(i.e. using |-escape if necessary). However, as a convention,
two things are different from the default symbol writer.
(1) We don't check the noninitials; :1 is unambiguously a
keyword, so we don't need to print :|1|.
(2) A keyword with an empty name can be printed just as :,
instead of :||.
These conventions are useful if we pass the S-expression with
these keywords to other Scheme implementations that don't support
CL-style keywords; they would just read those ones as symbols.
*/
Scm_WriteSymbolName(SCM_KEYWORD(obj)->name, port, ctx,
(SCM_SYMBOL_WRITER_NOESCAPE_INITIAL
|SCM_SYMBOL_WRITER_NOESCAPE_EMPTY));
return;
}
#endif /*!GAUCHE_UNIFY_SYMBOL_KEYWORD*/
if (!SCM_SYMBOL_INTERNED(obj)) SCM_PUTZ("#:", -1, port);
Scm_WriteSymbolName(SCM_SYMBOL_NAME(obj), port, ctx, 0);
}
}
/* Symbol printer.
NB: Uninterned symbols are treated as sharable objects (can be written
with #n= syntax). It is handled by upper layer (write.c) so we don't
worry about it in this routine.
*/
static void symbol_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
if (Scm_WriteContextMode(ctx) == SCM_WRITE_DISPLAY) {
SCM_PUTS(SCM_SYMBOL_NAME(obj), port);
} else {
if (!SCM_SYMBOL_INTERNED(obj)) SCM_PUTZ("#:", -1, port);
Scm_WriteSymbolName(SCM_SYMBOL_NAME(obj), port, ctx, 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;
}
}
/* internal function to write symbol name, with proper escaping */
void Scm_WriteSymbolName(ScmString *snam, ScmPort *port, ScmWriteContext *ctx,
u_int flags)
{
/* See if we have special characters, and use |-escape if necessary. */
/* TODO: For now, we regard chars over 0x80 is all "printable".
Need a more consistent mechanism. */
const ScmStringBody *b = SCM_STRING_BODY(snam);
const char *p = SCM_STRING_BODY_START(b);
int siz = SCM_STRING_BODY_SIZE(b);
int escape = FALSE;
int spmask = (Scm_WriteContextCase(ctx) == SCM_WRITE_CASE_FOLD)? 0x12 : 0x02;
if (siz == 0) { /* special case */
if (!(flags & SCM_SYMBOL_WRITER_NOESCAPE_EMPTY)) {
SCM_PUTZ("||", -1, port);
}
return;
}
if (siz == 1 && (*p == '+' || *p == '-')) {
SCM_PUTC((unsigned)*p, port);
return;
}
if ((unsigned int)*p < 128
&& (special[(unsigned int)*p]&1)
#if GAUCHE_UNIFY_SYMBOL_KEYWORD
&& (*p != ':')
#endif
&& (!(flags & SCM_SYMBOL_WRITER_NOESCAPE_INITIAL))) {
escape = TRUE;
} else {
const char *q = p;
for (int i=0; i<siz; i++, q++) {
if ((unsigned int)*q < 128
&& (special[(unsigned int)*q]&spmask)) {
escape = TRUE;
break;
}
}
}
if (escape) {
SCM_PUTC('|', port);
for (const char *q=p; q<p+siz; ) {
unsigned int ch;
SCM_CHAR_GET(q, ch);
q += SCM_CHAR_NBYTES(ch);
if (ch < 128) {
if (special[ch] & 8) {
SCM_PUTC('\\', port);
SCM_PUTC(ch, port);
} else if (special[ch] & 4) {
Scm_Printf(port, "\\x%02x;", ch);
} else {
SCM_PUTC(ch, port);
}
} else {
SCM_PUTC(ch, port);
}
}
SCM_PUTC('|', port);
return;
} else {
SCM_PUTS(snam, port);
}
}
