/* Returns # of chars written.
This can be better in char.c, but to do so, we'd better to clean up
public interface for ScmWriteContext.
TODO: It would be nice to have a mode to print character in unicode
character name.
*/
static size_t write_char(ScmChar ch, ScmPort *port, ScmWriteContext *ctx)
{
if (SCM_WRITE_MODE(ctx) == SCM_WRITE_DISPLAY) {
Scm_PutcUnsafe(ch, port);
return 1;
} else {
const char *cname = NULL;
char buf[SPBUFSIZ];
Scm_PutzUnsafe("#\\", -1, port);
if (ch <= 0x20) cname = char_names[ch];
else if (ch == 0x7f) cname = "del";
else {
switch (Scm_CharGeneralCategory(ch)) {
case SCM_CHAR_CATEGORY_Mn:
case SCM_CHAR_CATEGORY_Mc:
case SCM_CHAR_CATEGORY_Me:
case SCM_CHAR_CATEGORY_Zs:
case SCM_CHAR_CATEGORY_Zl:
case SCM_CHAR_CATEGORY_Zp:
case SCM_CHAR_CATEGORY_Cc:
case SCM_CHAR_CATEGORY_Cf:
case SCM_CHAR_CATEGORY_Cs:
case SCM_CHAR_CATEGORY_Co:
case SCM_CHAR_CATEGORY_Cn:
/* NB: Legacy Gauche uses native character code for #\xNNNN
notation, while R7RS uses Unicode codepoint. We eventually
need a write mode (legacy or r7rs) and switch the output
accordingly---the safe bet is to use #\uNNNN for legacy
mode and #\xNNNN for R7RS mode. */
snprintf(buf, SPBUFSIZ, "x%04x", (unsigned int)ch);
cname = buf;
break;
}
}
if (cname) {
Scm_PutzUnsafe(cname, -1, port);
return strlen(cname)+2; /* +2 for '#\' */
} else {
Scm_PutcUnsafe(ch, port);
return 3; /* +2 for '#\' */
}
}
}
/* Write/ss main driver
This should never be called recursively.
We modify port->flags and port->writeState; they are cleaned up
by the caller even if we throw an error during write. */
static void write_ss(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
SCM_ASSERT(port->writeState == NULL);
/* pass 1 */
port->flags |= SCM_PORT_WALKING;
if (SCM_WRITE_MODE(ctx)==SCM_WRITE_SHARED) port->flags |= SCM_PORT_WRITESS;
ScmWriteState *s = Scm_MakeWriteState(NULL);
s->sharedTable = SCM_HASH_TABLE(Scm_MakeHashTableSimple(SCM_HASH_EQ, 0));
port->writeState = s;
write_walk(obj, port);
port->flags &= ~(SCM_PORT_WALKING|SCM_PORT_WRITESS);
/* pass 2 */
write_rec(obj, port, ctx);
cleanup_port_write_state(port);
}
static void keyword_print(ScmObj obj, ScmPort *port, ScmWriteContext *ctx)
{
if (SCM_WRITE_MODE(ctx) == SCM_WRITE_DISPLAY) {
SCM_PUTS(SCM_KEYWORD(obj)->name, port);
} else {
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));
}
}
/*
* WriteContext public API
*/
int Scm_WriteContextMode(const ScmWriteContext *ctx)
{
return SCM_WRITE_MODE(ctx);
}
