/* In unified keyword, we include preceding ':' to the name. */
ScmObj Scm_MakeKeyword(ScmString *name)
{
#if GAUCHE_UNIFY_SYMBOL_KEYWORD
/* We could optimize this later. */
ScmObj prefix = Scm_MakeString(":", 1, 1, SCM_STRING_IMMUTABLE);
ScmObj sname = Scm_StringAppend2(SCM_STRING(prefix), name);
ScmSymbol *s = make_sym(SCM_CLASS_KEYWORD, SCM_STRING(sname), TRUE);
Scm_DefineConst(Scm_KeywordModule(), s, SCM_OBJ(s));
return SCM_OBJ(s);
#else /*!GAUCHE_UNIFY_SYMBOL_KEYWORD*/
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
ScmObj r = Scm_HashTableRef(keywords.table, SCM_OBJ(name), SCM_FALSE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
if (SCM_KEYWORDP(r)) return r;
ScmKeyword *k = SCM_NEW(ScmKeyword);
SCM_SET_CLASS(k, SCM_CLASS_KEYWORD);
k->name = SCM_STRING(Scm_CopyString(name));
(void)SCM_INTERNAL_MUTEX_LOCK(keywords.mutex);
r = Scm_HashTableSet(keywords.table, SCM_OBJ(name), SCM_OBJ(k),
SCM_DICT_NO_OVERWRITE);
(void)SCM_INTERNAL_MUTEX_UNLOCK(keywords.mutex);
return r;
#endif /*!GAUCHE_UNIFY_SYMBOL_KEYWORD*/
}
/* In unified keyword, we include preceding ':' to the name. */
ScmObj Scm_MakeKeyword(ScmString *name)
{
/* We could optimize this later. */
ScmObj prefix = Scm_MakeString(":", 1, 1, SCM_STRING_IMMUTABLE);
ScmObj sname = Scm_StringAppend2(SCM_STRING(prefix), name);
ScmSymbol *s = make_sym(SCM_CLASS_KEYWORD, SCM_STRING(sname), TRUE);
Scm_DefineConst(Scm_KeywordModule(), s, SCM_OBJ(s));
return SCM_OBJ(s);
}
ScmObj Scm_SocketRecv(ScmSocket *sock, int bytes, int flags)
{
int r;
CLOSE_CHECK(sock->fd, "recv from", sock);
char *buf = SCM_NEW_ATOMIC2(char*, bytes);
SCM_SYSCALL(r, recv(sock->fd, buf, bytes, flags));
if (r < 0) {
Scm_SysError("recv(2) failed");
}
return Scm_MakeString(buf, r, r, SCM_STRING_INCOMPLETE);
}
/* If symbol S has a prefix P, returns a symbol without the prefix.
Otherwise, returns #f. */
ScmObj Scm_SymbolSansPrefix(ScmSymbol *s, ScmSymbol *p)
{
const ScmStringBody *bp = SCM_STRING_BODY(SCM_SYMBOL_NAME(p));
const ScmStringBody *bs = SCM_STRING_BODY(SCM_SYMBOL_NAME(s));
int zp = SCM_STRING_BODY_SIZE(bp);
int zs = SCM_STRING_BODY_SIZE(bs);
const char *cp = SCM_STRING_BODY_START(bp);
const char *cs = SCM_STRING_BODY_START(bs);
if (zp > zs || memcmp(cp, cs, zp) != 0) return SCM_FALSE;
return Scm_Intern(SCM_STRING(Scm_MakeString(cs + zp, zs - zp, -1,
SCM_STRING_IMMUTABLE)));
}
ScmObj Scm_TLSRead(ScmTLS* t)
{
#if defined(GAUCHE_USE_AXTLS)
context_check(t, "read");
close_check(t, "read");
int r; uint8_t* buf;
while ((r = ssl_read(t->conn, &buf)) == SSL_OK);
if (r < 0) Scm_SysError("ssl_read() failed");
return Scm_MakeString((char*) buf, r, r, SCM_STRING_INCOMPLETE);
#else /*!GAUCHE_USE_AXTLS*/
return SCM_FALSE;
#endif /*!GAUCHE_USE_AXTLS*/
}
ScmObj Scm_SocketRecvFrom(ScmSocket *sock, int bytes, int flags)
{
int r;
struct sockaddr_storage from;
socklen_t fromlen = sizeof(from);
CLOSE_CHECK(sock->fd, "recv from", sock);
char *buf = SCM_NEW_ATOMIC2(char*, bytes);
SCM_SYSCALL(r, recvfrom(sock->fd, buf, bytes, flags,
(struct sockaddr*)&from, &fromlen));
if (r < 0) {
Scm_SysError("recvfrom(2) failed");
}
return Scm_Values2(Scm_MakeString(buf, r, r, SCM_STRING_INCOMPLETE),
Scm_MakeSockAddr(NULL, (struct sockaddr*)&from, fromlen));
}
/*------------------------------------------------------------
* Vport putz
*/
static void vport_putz(const char *buf, int size, ScmPort *p)
{
vport *data = (vport*)p->src.vt.data;
SCM_ASSERT(data != NULL);
if (!SCM_FALSEP(data->puts_proc)) {
Scm_ApplyRec(data->puts_proc,
SCM_LIST1(Scm_MakeString(buf, size, -1,
SCM_STRING_COPYING)));
} else if (!SCM_FALSEP(data->putb_proc)) {
for (int i=0; i<size; i++) {
unsigned char b = buf[i];
Scm_ApplyRec(data->putb_proc, SCM_LIST1(SCM_MAKE_INT(b)));
}
} else {
Scm_PortError(p, SCM_PORT_ERROR_UNIT,
"cannot perform binary output to the port %S", p);
}
}
ScmObj read_clipboard(void)
{
ScmObj result;
OpenClipboard(NULL);
HANDLE hText = GetClipboardData(CF_UNICODETEXT);
if(hText == NULL) result = SCM_FALSE;
else {
WCHAR *pText = GlobalLock(hText);
int nb = WideCharToMultiByte(CP_UTF8, 0, pText, -1, NULL, 0, 0, 0);
if (nb == 0) {
Scm_Error("Windows error %d on WideCharToMultiByte", GetLastError());
}
char *mb = SCM_NEW_ATOMIC_ARRAY(char, nb);
if (WideCharToMultiByte(CP_UTF8, 0, pText, -1, mb, nb, 0, 0) == 0) {
Scm_Error("Windows error %d on WideCharToMultiByte", GetLastError());
}
GlobalUnlock(hText);
result = Scm_MakeString(mb, -1, -1, 0);
}
CloseClipboard();
return result;
}
static int conv_input_filler(ScmPort *port, int mincnt)
{
ScmConvInfo *info = (ScmConvInfo*)port->src.buf.data;
const char *inbuf = info->buf;
char *outbuf = port->src.buf.end;
if (info->remoteClosed) return 0;
/* Fill the input buffer. There may be some remaining bytes in the
inbuf from the last conversion (insize), so we try to fill the
rest. */
size_t insize = info->ptr - info->buf;
int nread = Scm_Getz(info->ptr, info->bufsiz - (int)insize, info->remote);
if (nread <= 0) {
/* input reached EOF. finish the output state */
if (insize == 0) {
size_t outroom = SCM_PORT_BUFFER_ROOM(port);
size_t result = jconv_reset(info, outbuf, outroom);
if (result == OUTPUT_NOT_ENOUGH) {
/* The port buffer doesn't have enough space to contain the
finishing sequence. Its unusual, for the port buffer
must be almost empty at this time, and the finishing
sequence is usually just a few bytes.
We signal an error. */
Scm_Error("couldn't flush the ending escape sequence in the character encoding conversion port (%s -> %s). possibly an implementation error",
info->fromCode, info->toCode);
}
if (info->ownerp) {
Scm_ClosePort(info->remote);
info->remoteClosed = TRUE;
}
#ifdef JCONV_DEBUG
fprintf(stderr, "<= r=%d (reset), out(%p)%d\n",
result, outbuf, outroom);
#endif
return (int)result;
}
} else {
insize += nread;
}
/* Conversion. */
size_t inroom = insize;
size_t outroom = SCM_PORT_BUFFER_ROOM(port);
#ifdef JCONV_DEBUG
fprintf(stderr, "=> in(%p)%d out(%p)%d\n", inbuf, insize, outbuf, outroom);
#endif
size_t result = jconv(info, &inbuf, &inroom, &outbuf, &outroom);
#ifdef JCONV_DEBUG
fprintf(stderr, "<= r=%d, in(%p)%d out(%p)%d\n",
result, inbuf, inroom, outbuf, outroom);
#endif
/* we've got an error. */
if (result == INPUT_NOT_ENOUGH || result == OUTPUT_NOT_ENOUGH) {
/* Conversion stopped due to an incomplete character at the
end of the input buffer, or the output buffer is full.
We shift the unconverted bytes to the beginning of input
buffer. */
memmove(info->buf, info->buf+insize-inroom, inroom);
info->ptr = info->buf + inroom;
return info->bufsiz - (int)outroom;
} else if (result == ILLEGAL_SEQUENCE) {
/* it's likely that the input contains invalid sequence. */
int cnt = inroom >= 6 ? 6 : (int)inroom;
ScmObj s = Scm_MakeString(info->buf+insize-inroom, cnt, cnt,
SCM_STRING_COPYING|SCM_STRING_INCOMPLETE);
Scm_Error("invalid character sequence in the input stream: %S ...", s);
}
/* Conversion is done completely. */
/* NB: There are cases that some bytes are left in the input buffer
even iconv returns positive value. We need to shift those bytes. */
if (inroom > 0) {
memmove(info->buf, info->buf+insize-inroom, inroom);
info->ptr = info->buf + inroom;
return info->bufsiz - (int)outroom;
} else {
info->ptr = info->buf;
return info->bufsiz - (int)outroom;
}
}
