/* 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); }