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