[doldaconnect.git] / lib / guile / dolcon-guile.c

/*
 *  Dolda Connect - Modular multiuser Direct Connect-style client
 *  Copyright (C) 2007 Fredrik Tolf <fredrik@dolda2000.com>
 *  
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *  
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *  
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
*/
#include <stdlib.h>
#include <stdio.h>
#include <sys/poll.h>
#include <errno.h>
#include <libguile.h>

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif
#include <doldaconnect/uilib.h>
#include <doldaconnect/uimisc.h>
#include <doldaconnect/utils.h>

struct respsmob
{
    struct dc_response *resp;
};

struct scmcb
{
    SCM subr;
};

static int fd = -1;
static scm_t_bits resptype;

static SCM scm_dc_connect(SCM host)
{
    char *chost;
    
    if(fd >= 0)
	dc_disconnect();
    if((host == SCM_UNDEFINED) || (host == SCM_BOOL_F))
    {
	chost = NULL;
    } else {
	SCM_ASSERT(scm_is_string(host), host, SCM_ARG1, "dc-connect");
	chost = scm_to_locale_string(host);
    }
    fd = dc_connect(chost);
    if(chost != NULL)
	free(chost);
    if(fd < 0)
	scm_syserror("dc-connect");
    return(scm_from_int(fd));
}

static SCM scm_dc_disconnect(void)
{
    dc_disconnect();
    return(scm_from_int(0));
}

static SCM scm_dc_connected(void)
{
    return((fd == -1)?SCM_BOOL_F:SCM_BOOL_T);
}

static SCM scm_dc_select(SCM timeout)
{
    struct pollfd pfd;
    int cto, ret, enob;
    
    if(timeout == SCM_UNDEFINED)
    {
	cto = -1;
    } else {
	SCM_ASSERT(scm_is_integer(timeout), timeout, SCM_ARG1, "dc-select");
	cto = scm_to_int(timeout);
    }
    if(fd < 0)
	scm_syserror_msg("dc-select", "Not connected", SCM_EOL, ENOTCONN);
    pfd.fd = fd;
    pfd.events = POLLIN;
    if(dc_wantwrite())
	pfd.events |= POLLOUT;
    if((ret = poll(&pfd, 1, cto)) < 0)
    {
	if(errno == EINTR)
	    return(SCM_BOOL_F);
	enob = errno;
	dc_disconnect();
	errno = enob;
	scm_syserror("dc-select");
    }
    if(((pfd.revents & POLLIN) && dc_handleread()) || ((pfd.revents & POLLOUT) && dc_handlewrite()))
    {
	if(errno == 0)
	{
	    fd = -1;
	    return(SCM_BOOL_F);
	}
	scm_syserror("dc-select");
    }
    return(ret?SCM_BOOL_T:SCM_BOOL_F);
}

static SCM makerespsmob(struct dc_response *resp)
{
    struct respsmob *data;
    
    data = scm_gc_malloc(sizeof(*data), "respsmob");
    data->resp = resp;
    SCM_RETURN_NEWSMOB(resptype, data);
}

static SCM scm_dc_getresp(SCM tag)
{
    struct dc_response *resp;
    SCM ret;
    
    if(tag == SCM_UNDEFINED)
    {
	if((resp = dc_getresp()) == NULL)
	    return(SCM_BOOL_F);
    } else {
	SCM_ASSERT(scm_is_integer(tag), tag, SCM_ARG1, "dc-getresp");
	if((resp = dc_gettaggedresp(scm_to_int(tag))) == NULL)
	    return(SCM_BOOL_F);
    }
    ret = makerespsmob(resp);
    return(ret);
}

static SCM scm_dc_extract(SCM scm_resp)
{
    int i, o;
    struct dc_response *resp;
    SCM ret, l, w;
    
    SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-extract");
    resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
    ret = SCM_EOL;
    ret = scm_cons(scm_cons(scm_str2symbol("cmd"), scm_makfrom0str(icswcstombs(resp->cmdname, "UTF-8", NULL))), ret);
    ret = scm_cons(scm_cons(scm_str2symbol("code"), scm_from_int(resp->code)), ret);
    ret = scm_cons(scm_cons(scm_str2symbol("tag"), scm_from_int(resp->tag)), ret);
    l = SCM_EOL;
    for(i = resp->numlines - 1; i >= 0; i--)
    {
	w = SCM_EOL;
	for(o = resp->rlines[i].argc - 1; o >= 0; o--)
	    w = scm_cons(scm_makfrom0str(icswcstombs(resp->rlines[i].argv[o], "UTF-8", NULL)), w);
	l = scm_cons(w, l);
    }
    ret = scm_cons(scm_cons(scm_str2symbol("resp"), l), ret);
    return(ret);
}

static SCM scm_dc_intresp(SCM scm_resp)
{
    int i;
    struct dc_response *resp;
    struct dc_intresp *ires;
    SCM ret;
    
    SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-intresp");
    resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
    if((ires = dc_interpret(resp)) == NULL)
	return(SCM_BOOL_F);
    ret = SCM_EOL;
    for(i = ires->argc - 1; i >= 0; i--)
    {
	switch(ires->argv[i].type)
	{
	case 1:
	    ret = scm_cons(scm_makfrom0str(icswcstombs(ires->argv[i].val.str, "UTF-8", NULL)), ret);
	    break;
	case 2:
	    ret = scm_cons(scm_int2num(ires->argv[i].val.num), ret);
	    break;
	case 3:
	    ret = scm_cons(scm_double2num(ires->argv[i].val.flnum), ret);
	    break;
	}
    }
    dc_freeires(ires);
    return(ret);
}

static int qcmd_scmcb(struct dc_response *resp)
{
    struct scmcb *scmcb;
    
    scmcb = resp->data;
    scm_apply(scmcb->subr, scm_cons(makerespsmob(resp), SCM_EOL), SCM_EOL);
    scm_gc_unprotect_object(scmcb->subr);
    free(scmcb);
    return(2);
}

static wchar_t *scm_string_to_wcs(SCM str)
{
    char *buf;
    wchar_t *ret;
    
    buf = scm_to_locale_string(str);
    ret = icmbstowcs(buf, NULL);
    free(buf);
    return(ret);
}

static SCM scm_dc_qcmd(SCM argv, SCM callback)
{
    int tag, enob;
    wchar_t **toks, *tok, *cmd;
    size_t tokssize, toksdata;
    SCM port;
    struct scmcb *scmcb;
    
    SCM_ASSERT(SCM_CONSP(argv), argv, SCM_ARG1, "dc-qcmd");
    if(callback != SCM_UNDEFINED)
	SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG2, "dc-qcmd");
    cmd = NULL;
    toks = NULL;
    tokssize = toksdata = 0;
    for(; argv != SCM_EOL; argv = SCM_CDR(argv))
    {
	port = scm_open_output_string();
	scm_display(SCM_CAR(argv), port);
	if((tok = scm_string_to_wcs(scm_get_output_string(port))) == NULL)
	{
	    enob = errno;
	    addtobuf(toks, NULL);
	    dc_freewcsarr(toks);
	    if(cmd != NULL)
		free(cmd);
	    errno = enob;
	    scm_syserror("dc-qcmd");
	}
	if(cmd == NULL)
	    cmd = tok;
	else
	    addtobuf(toks, tok);
    }
    addtobuf(toks, NULL);
    if(callback == SCM_UNDEFINED)
    {
	tag = dc_queuecmd(NULL, NULL, cmd, L"%a", toks, NULL);
    } else {
	scmcb = scm_malloc(sizeof(*scmcb));
	scm_gc_protect_object(scmcb->subr = callback);
	tag = dc_queuecmd(qcmd_scmcb, scmcb, cmd, L"%a", toks, NULL);
    }
    dc_freewcsarr(toks);
    if(cmd != NULL)
	free(cmd);
    if(tag == -1) {
	if(errno == ENOSYS) {
	    scm_error(scm_str2symbol("no-such-cmd"), "dc-qcmd", "Invalid command name", SCM_EOL, SCM_BOOL_F);
	} else if(errno == EINVAL) {
	    scm_error(scm_str2symbol("illegal-escape"), "dc-qcmd", "Invalid escape sequence", SCM_EOL, SCM_BOOL_F);
	} else {
	    scm_syserror("dc-qcmd");
	}
    } else {
	return(scm_from_int(tag));
    }
}

static void login_scmcb(int err, wchar_t *reason, struct scmcb *scmcb)
{
    SCM errsym;
    
    switch(err)
    {
    case DC_LOGIN_ERR_SUCCESS:
	errsym = scm_str2symbol("success");
	break;
    case DC_LOGIN_ERR_NOLOGIN:
	errsym = scm_str2symbol("nologin");
	break;
    case DC_LOGIN_ERR_SERVER:
	errsym = scm_str2symbol("server");
	break;
    case DC_LOGIN_ERR_USER:
	errsym = scm_str2symbol("user");
	break;
    case DC_LOGIN_ERR_CONV:
	errsym = scm_str2symbol("conv");
	break;
    case DC_LOGIN_ERR_AUTHFAIL:
	errsym = scm_str2symbol("authfail");
	break;
    }
    scm_apply(scmcb->subr, scm_cons(errsym, scm_cons((reason == NULL)?SCM_BOOL_F:scm_makfrom0str(icswcstombs(reason, "UTF-8", NULL)), SCM_EOL)), SCM_EOL);
    scm_gc_unprotect_object(scmcb->subr);
    free(scmcb);
}

static SCM scm_dc_loginasync(SCM callback, SCM useauthless, SCM username)
{
    struct scmcb *scmcb;
    char *un;
    
    SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
    scmcb = scm_malloc(sizeof(*scmcb));
    scm_gc_protect_object(scmcb->subr = callback);
    if(scm_is_string(username))
	un = scm_to_locale_string(username);
    else
	un = NULL;
    dc_loginasync(un, SCM_NFALSEP(useauthless), NULL, (void (*)(int, wchar_t *, void *))login_scmcb, scmcb);
    if(un != NULL)
	free(un);
    return(SCM_BOOL_T);
}

static SCM scm_dc_lexsexpr(SCM sexpr)
{
    SCM ret;
    wchar_t **arr, **ap, *buf;
    
    SCM_ASSERT(scm_is_string(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
    if((buf = scm_string_to_wcs(sexpr)) == NULL)
	scm_syserror("dc-lexsexpr");
    arr = dc_lexsexpr(buf);
    free(buf);
    ret = SCM_EOL;
    if(arr != NULL)
    {
	for(ap = arr; *ap != NULL; ap++)
	    ret = scm_cons(scm_makfrom0str(icswcstombs(*ap, "UTF-8", NULL)), ret);
	dc_freewcsarr(arr);
    }
    return(scm_reverse(ret));
}

static SCM scm_dc_checkproto(SCM resp, SCM version)
{
    int ver;
    
    SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, resp), resp, SCM_ARG1, "dc-checkproto");
    if(version == SCM_UNDEFINED)
    {
	ver = DC_LATEST;
    } else {
	SCM_ASSERT(scm_is_integer(version), version, SCM_ARG2, "dc-checkproto");
	ver = scm_to_int(version);
    }
    if(dc_checkprotocol(((struct respsmob *)SCM_SMOB_DATA(resp))->resp, ver))
	return(SCM_BOOL_F);
    else
	return(SCM_BOOL_T);
}

static size_t resp_free(SCM respsmob)
{
    struct respsmob *data;
    
    data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
    dc_freeresp(data->resp);
    scm_gc_free(data, sizeof(*data), "respsmob");
    return(0);
}

static int resp_print(SCM respsmob, SCM port, scm_print_state *pstate)
{
    struct respsmob *data;
    
    data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
    scm_puts("#<dc-response ", port);
    scm_display(scm_from_int(data->resp->tag), port);
    scm_puts(" ", port);
    scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
    scm_puts(" ", port);
    scm_display(scm_from_int(data->resp->code), port);
    scm_puts(">", port);
    return(1);
}

void init_guiledc(void)
{
    scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
    scm_c_define_gsubr("dc-disconnect", 0, 0, 0, scm_dc_disconnect);
    scm_c_define_gsubr("dc-connected", 0, 0, 0, scm_dc_connected);
    scm_c_define_gsubr("dc-select", 0, 1, 0, scm_dc_select);
    scm_c_define_gsubr("dc-getresp", 0, 1, 0, scm_dc_getresp);
    scm_c_define_gsubr("dc-extract", 1, 0, 0, scm_dc_extract);
    scm_c_define_gsubr("dc-intresp", 1, 0, 0, scm_dc_intresp);
    scm_c_define_gsubr("dc-qcmd", 1, 1, 0, scm_dc_qcmd);
    scm_c_define_gsubr("dc-loginasync", 2, 1, 0, scm_dc_loginasync);
    scm_c_define_gsubr("dc-lexsexpr", 1, 0, 0, scm_dc_lexsexpr);
    scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
    scm_c_define("dc-latest", scm_from_int(DC_LATEST));
    resptype = scm_make_smob_type("dc-resp", sizeof(struct respsmob));
    scm_set_smob_free(resptype, resp_free);
    scm_set_smob_print(resptype, resp_print);
    dc_init();
}
Commit	Line	Data
3af4536f FT	1	/*
	2	* Dolda Connect - Modular multiuser Direct Connect-style client
	3	* Copyright (C) 2007 Fredrik Tolf <fredrik@dolda2000.com>
	4	*
	5	* This program is free software; you can redistribute it and/or modify
	6	* it under the terms of the GNU General Public License as published by
	7	* the Free Software Foundation; either version 2 of the License, or
	8	* (at your option) any later version.
	9	*
	10	* This program is distributed in the hope that it will be useful,
	11	* but WITHOUT ANY WARRANTY; without even the implied warranty of
	12	* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	13	* GNU General Public License for more details.
	14	*
	15	* You should have received a copy of the GNU General Public License
	16	* along with this program; if not, write to the Free Software
	17	* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
	18	*/
d3372da9	19	#include <stdlib.h>
	20	#include <stdio.h>
	21	#include <sys/poll.h>
	22	#include <errno.h>
	23	#include <libguile.h>
	24
	25	#ifdef HAVE_CONFIG_H
	26	#include <config.h>
	27	#endif
	28	#include <doldaconnect/uilib.h>
	29	#include <doldaconnect/uimisc.h>
	30	#include <doldaconnect/utils.h>
	31
	32	struct respsmob
	33	{
	34	struct dc_response *resp;
	35	};
	36
	37	struct scmcb
	38	{
	39	SCM subr;
	40	};
	41
	42	static int fd = -1;
dda84ebc	43	static scm_t_bits resptype;
d3372da9	44
12383d48	45	static SCM scm_dc_connect(SCM host)
d3372da9	46	{
12383d48	47	char *chost;
d3372da9	48
12383d48	49	if(fd >= 0)
12383d48	50	dc_disconnect();
0b8b2b53	51	if((host == SCM_UNDEFINED) \|\| (host == SCM_BOOL_F))
d3372da9	52	{
12383d48	53	chost = NULL;
d3372da9	54	} else {
91333cf2 FT	55	SCM_ASSERT(scm_is_string(host), host, SCM_ARG1, "dc-connect");
91333cf2 FT	56	chost = scm_to_locale_string(host);
d3372da9	57	}
91333cf2 FT	58	fd = dc_connect(chost);
	59	if(chost != NULL)
	60	free(chost);
	61	if(fd < 0)
d3372da9	62	scm_syserror("dc-connect");
91333cf2	63	return(scm_from_int(fd));
d3372da9	64	}
	65
	66	static SCM scm_dc_disconnect(void)
	67	{
	68	dc_disconnect();
91333cf2	69	return(scm_from_int(0));
d3372da9	70	}
	71
	72	static SCM scm_dc_connected(void)
	73	{
	74	return((fd == -1)?SCM_BOOL_F:SCM_BOOL_T);
	75	}
	76
	77	static SCM scm_dc_select(SCM timeout)
	78	{
	79	struct pollfd pfd;
	80	int cto, ret, enob;
	81
	82	if(timeout == SCM_UNDEFINED)
	83	{
	84	cto = -1;
	85	} else {
91333cf2 FT	86	SCM_ASSERT(scm_is_integer(timeout), timeout, SCM_ARG1, "dc-select");
91333cf2 FT	87	cto = scm_to_int(timeout);
d3372da9	88	}
	89	if(fd < 0)
	90	scm_syserror_msg("dc-select", "Not connected", SCM_EOL, ENOTCONN);
	91	pfd.fd = fd;
	92	pfd.events = POLLIN;
	93	if(dc_wantwrite())
	94	pfd.events \|= POLLOUT;
	95	if((ret = poll(&pfd, 1, cto)) < 0)
	96	{
	97	if(errno == EINTR)
	98	return(SCM_BOOL_F);
	99	enob = errno;
	100	dc_disconnect();
	101	errno = enob;
	102	scm_syserror("dc-select");
	103	}
	104	if(((pfd.revents & POLLIN) && dc_handleread()) \|\| ((pfd.revents & POLLOUT) && dc_handlewrite()))
	105	{
	106	if(errno == 0)
	107	{
	108	fd = -1;
	109	return(SCM_BOOL_F);
	110	}
	111	scm_syserror("dc-select");
	112	}
	113	return(ret?SCM_BOOL_T:SCM_BOOL_F);
	114	}
	115
	116	static SCM makerespsmob(struct dc_response *resp)
	117	{
	118	struct respsmob *data;
	119
91333cf2	120	data = scm_gc_malloc(sizeof(*data), "respsmob");
d3372da9	121	data->resp = resp;
	122	SCM_RETURN_NEWSMOB(resptype, data);
	123	}
	124
	125	static SCM scm_dc_getresp(SCM tag)
	126	{
	127	struct dc_response *resp;
	128	SCM ret;
	129
	130	if(tag == SCM_UNDEFINED)
	131	{
	132	if((resp = dc_getresp()) == NULL)
	133	return(SCM_BOOL_F);
	134	} else {
91333cf2 FT	135	SCM_ASSERT(scm_is_integer(tag), tag, SCM_ARG1, "dc-getresp");
91333cf2 FT	136	if((resp = dc_gettaggedresp(scm_to_int(tag))) == NULL)
d3372da9	137	return(SCM_BOOL_F);
	138	}
	139	ret = makerespsmob(resp);
	140	return(ret);
	141	}
	142
	143	static SCM scm_dc_extract(SCM scm_resp)
	144	{
	145	int i, o;
	146	struct dc_response *resp;
	147	SCM ret, l, w;
	148
	149	SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-extract");
	150	resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
	151	ret = SCM_EOL;
	152	ret = scm_cons(scm_cons(scm_str2symbol("cmd"), scm_makfrom0str(icswcstombs(resp->cmdname, "UTF-8", NULL))), ret);
91333cf2 FT	153	ret = scm_cons(scm_cons(scm_str2symbol("code"), scm_from_int(resp->code)), ret);
91333cf2 FT	154	ret = scm_cons(scm_cons(scm_str2symbol("tag"), scm_from_int(resp->tag)), ret);
d3372da9	155	l = SCM_EOL;
	156	for(i = resp->numlines - 1; i >= 0; i--)
	157	{
	158	w = SCM_EOL;
	159	for(o = resp->rlines[i].argc - 1; o >= 0; o--)
	160	w = scm_cons(scm_makfrom0str(icswcstombs(resp->rlines[i].argv[o], "UTF-8", NULL)), w);
	161	l = scm_cons(w, l);
	162	}
	163	ret = scm_cons(scm_cons(scm_str2symbol("resp"), l), ret);
	164	return(ret);
	165	}
	166
	167	static SCM scm_dc_intresp(SCM scm_resp)
	168	{
	169	int i;
	170	struct dc_response *resp;
	171	struct dc_intresp *ires;
	172	SCM ret;
	173
	174	SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-intresp");
	175	resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
	176	if((ires = dc_interpret(resp)) == NULL)
	177	return(SCM_BOOL_F);
	178	ret = SCM_EOL;
	179	for(i = ires->argc - 1; i >= 0; i--)
	180	{
	181	switch(ires->argv[i].type)
	182	{
	183	case 1:
	184	ret = scm_cons(scm_makfrom0str(icswcstombs(ires->argv[i].val.str, "UTF-8", NULL)), ret);
	185	break;
	186	case 2:
	187	ret = scm_cons(scm_int2num(ires->argv[i].val.num), ret);
	188	break;
	189	case 3:
	190	ret = scm_cons(scm_double2num(ires->argv[i].val.flnum), ret);
	191	break;
	192	}
	193	}
	194	dc_freeires(ires);
	195	return(ret);
	196	}
	197
	198	static int qcmd_scmcb(struct dc_response *resp)
	199	{
	200	struct scmcb *scmcb;
	201
	202	scmcb = resp->data;
	203	scm_apply(scmcb->subr, scm_cons(makerespsmob(resp), SCM_EOL), SCM_EOL);
	204	scm_gc_unprotect_object(scmcb->subr);
	205	free(scmcb);
	206	return(2);
	207	}
	208
91333cf2 FT	209	static wchar_t *scm_string_to_wcs(SCM str)
	210	{
	211	char *buf;
	212	wchar_t *ret;
	213
	214	buf = scm_to_locale_string(str);
	215	ret = icmbstowcs(buf, NULL);
	216	free(buf);
	217	return(ret);
	218	}
	219
d3372da9	220	static SCM scm_dc_qcmd(SCM argv, SCM callback)
	221	{
	222	int tag, enob;
	223	wchar_t *toks, tok, *cmd;
	224	size_t tokssize, toksdata;
	225	SCM port;
	226	struct scmcb *scmcb;
	227
	228	SCM_ASSERT(SCM_CONSP(argv), argv, SCM_ARG1, "dc-qcmd");
	229	if(callback != SCM_UNDEFINED)
	230	SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG2, "dc-qcmd");
	231	cmd = NULL;
	232	toks = NULL;
	233	tokssize = toksdata = 0;
	234	for(; argv != SCM_EOL; argv = SCM_CDR(argv))
	235	{
	236	port = scm_open_output_string();
	237	scm_display(SCM_CAR(argv), port);
91333cf2	238	if((tok = scm_string_to_wcs(scm_get_output_string(port))) == NULL)
d3372da9	239	{
	240	enob = errno;
	241	addtobuf(toks, NULL);
	242	dc_freewcsarr(toks);
	243	if(cmd != NULL)
	244	free(cmd);
	245	errno = enob;
	246	scm_syserror("dc-qcmd");
	247	}
	248	if(cmd == NULL)
	249	cmd = tok;
	250	else
	251	addtobuf(toks, tok);
	252	}
	253	addtobuf(toks, NULL);
	254	if(callback == SCM_UNDEFINED)
	255	{
0931eb36	256	tag = dc_queuecmd(NULL, NULL, cmd, L"%a", toks, NULL);
d3372da9	257	} else {
91333cf2	258	scmcb = scm_malloc(sizeof(*scmcb));
d3372da9	259	scm_gc_protect_object(scmcb->subr = callback);
0931eb36	260	tag = dc_queuecmd(qcmd_scmcb, scmcb, cmd, L"%a", toks, NULL);
d3372da9	261	}
	262	dc_freewcsarr(toks);
	263	if(cmd != NULL)
	264	free(cmd);
fee53a96 FT	265	if(tag == -1) {
	266	if(errno == ENOSYS) {
	267	scm_error(scm_str2symbol("no-such-cmd"), "dc-qcmd", "Invalid command name", SCM_EOL, SCM_BOOL_F);
	268	} else if(errno == EINVAL) {
	269	scm_error(scm_str2symbol("illegal-escape"), "dc-qcmd", "Invalid escape sequence", SCM_EOL, SCM_BOOL_F);
	270	} else {
	271	scm_syserror("dc-qcmd");
	272	}
	273	} else {
	274	return(scm_from_int(tag));
	275	}
d3372da9	276	}
	277
	278	static void login_scmcb(int err, wchar_t reason, struct scmcb scmcb)
	279	{
	280	SCM errsym;
	281
	282	switch(err)
	283	{
	284	case DC_LOGIN_ERR_SUCCESS:
	285	errsym = scm_str2symbol("success");
	286	break;
	287	case DC_LOGIN_ERR_NOLOGIN:
	288	errsym = scm_str2symbol("nologin");
	289	break;
	290	case DC_LOGIN_ERR_SERVER:
	291	errsym = scm_str2symbol("server");
	292	break;
	293	case DC_LOGIN_ERR_USER:
	294	errsym = scm_str2symbol("user");
	295	break;
	296	case DC_LOGIN_ERR_CONV:
	297	errsym = scm_str2symbol("conv");
	298	break;
	299	case DC_LOGIN_ERR_AUTHFAIL:
	300	errsym = scm_str2symbol("authfail");
	301	break;
	302	}
	303	scm_apply(scmcb->subr, scm_cons(errsym, scm_cons((reason == NULL)?SCM_BOOL_F:scm_makfrom0str(icswcstombs(reason, "UTF-8", NULL)), SCM_EOL)), SCM_EOL);
	304	scm_gc_unprotect_object(scmcb->subr);
	305	free(scmcb);
	306	}
	307
	308	static SCM scm_dc_loginasync(SCM callback, SCM useauthless, SCM username)
	309	{
	310	struct scmcb *scmcb;
91333cf2	311	char *un;
d3372da9	312
d3372da9	313	SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
91333cf2	314	scmcb = scm_malloc(sizeof(*scmcb));
d3372da9	315	scm_gc_protect_object(scmcb->subr = callback);
91333cf2 FT	316	if(scm_is_string(username))
	317	un = scm_to_locale_string(username);
	318	else
	319	un = NULL;
	320	dc_loginasync(un, SCM_NFALSEP(useauthless), NULL, (void ()(int, wchar_t , void *))login_scmcb, scmcb);
	321	if(un != NULL)
	322	free(un);
d3372da9	323	return(SCM_BOOL_T);
	324	}
	325
	326	static SCM scm_dc_lexsexpr(SCM sexpr)
	327	{
	328	SCM ret;
	329	wchar_t arr, ap, *buf;
	330
91333cf2 FT	331	SCM_ASSERT(scm_is_string(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
91333cf2 FT	332	if((buf = scm_string_to_wcs(sexpr)) == NULL)
d3372da9	333	scm_syserror("dc-lexsexpr");
	334	arr = dc_lexsexpr(buf);
	335	free(buf);
	336	ret = SCM_EOL;
	337	if(arr != NULL)
	338	{
	339	for(ap = arr; *ap != NULL; ap++)
	340	ret = scm_cons(scm_makfrom0str(icswcstombs(*ap, "UTF-8", NULL)), ret);
	341	dc_freewcsarr(arr);
	342	}
	343	return(scm_reverse(ret));
	344	}
	345
9cbeb60c	346	static SCM scm_dc_checkproto(SCM resp, SCM version)
	347	{
	348	int ver;
	349
	350	SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, resp), resp, SCM_ARG1, "dc-checkproto");
	351	if(version == SCM_UNDEFINED)
	352	{
	353	ver = DC_LATEST;
	354	} else {
91333cf2 FT	355	SCM_ASSERT(scm_is_integer(version), version, SCM_ARG2, "dc-checkproto");
91333cf2 FT	356	ver = scm_to_int(version);
9cbeb60c	357	}
	358	if(dc_checkprotocol(((struct respsmob *)SCM_SMOB_DATA(resp))->resp, ver))
	359	return(SCM_BOOL_F);
	360	else
	361	return(SCM_BOOL_T);
	362	}
	363
d3372da9	364	static size_t resp_free(SCM respsmob)
	365	{
	366	struct respsmob *data;
	367
	368	data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
	369	dc_freeresp(data->resp);
91333cf2 FT	370	scm_gc_free(data, sizeof(*data), "respsmob");
91333cf2 FT	371	return(0);
d3372da9	372	}
	373
	374	static int resp_print(SCM respsmob, SCM port, scm_print_state *pstate)
	375	{
	376	struct respsmob *data;
	377
	378	data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
	379	scm_puts("#<dc-response ", port);
91333cf2	380	scm_display(scm_from_int(data->resp->tag), port);
d3372da9	381	scm_puts(" ", port);
	382	scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
	383	scm_puts(" ", port);
91333cf2	384	scm_display(scm_from_int(data->resp->code), port);
d3372da9	385	scm_puts(">", port);
	386	return(1);
	387	}
	388
	389	void init_guiledc(void)
	390	{
12383d48	391	scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
d3372da9	392	scm_c_define_gsubr("dc-disconnect", 0, 0, 0, scm_dc_disconnect);
	393	scm_c_define_gsubr("dc-connected", 0, 0, 0, scm_dc_connected);
	394	scm_c_define_gsubr("dc-select", 0, 1, 0, scm_dc_select);
	395	scm_c_define_gsubr("dc-getresp", 0, 1, 0, scm_dc_getresp);
	396	scm_c_define_gsubr("dc-extract", 1, 0, 0, scm_dc_extract);
	397	scm_c_define_gsubr("dc-intresp", 1, 0, 0, scm_dc_intresp);
	398	scm_c_define_gsubr("dc-qcmd", 1, 1, 0, scm_dc_qcmd);
	399	scm_c_define_gsubr("dc-loginasync", 2, 1, 0, scm_dc_loginasync);
	400	scm_c_define_gsubr("dc-lexsexpr", 1, 0, 0, scm_dc_lexsexpr);
9cbeb60c	401	scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
91333cf2	402	scm_c_define("dc-latest", scm_from_int(DC_LATEST));
d3372da9	403	resptype = scm_make_smob_type("dc-resp", sizeof(struct respsmob));
	404	scm_set_smob_free(resptype, resp_free);
	405	scm_set_smob_print(resptype, resp_print);
	406	dc_init();
	407	}