[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_STRINGP(host), host, SCM_ARG1, "dc-connect");
	chost = SCM_STRING_CHARS(host);
    }
    if((fd = dc_connect(chost)) < 0)
	scm_syserror("dc-connect");
    return(SCM_MAKINUM(fd));
}

static SCM scm_dc_disconnect(void)
{
    dc_disconnect();
    return(SCM_MAKINUM(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_INUMP(timeout), timeout, SCM_ARG1, "dc-select");
	cto = SCM_INUM(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_must_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_INUMP(tag), tag, SCM_ARG1, "dc-getresp");
	if((resp = dc_gettaggedresp(SCM_INUM(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_MAKINUM(resp->code)), ret);
    ret = scm_cons(scm_cons(scm_str2symbol("tag"), SCM_MAKINUM(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 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 = icmbstowcs(SCM_STRING_CHARS(scm_get_output_string(port)), "UTF-8")) == 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_must_malloc(sizeof(*scmcb), "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);
    return(SCM_MAKINUM(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;
    
    SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
    scmcb = scm_must_malloc(sizeof(*scmcb), "scmcb");
    scm_gc_protect_object(scmcb->subr = callback);
    dc_loginasync(SCM_STRINGP(username)?SCM_STRING_CHARS(username):NULL, SCM_NFALSEP(useauthless), NULL, (void (*)(int, wchar_t *, void *))login_scmcb, scmcb);
    return(SCM_BOOL_T);
}

static SCM scm_dc_lexsexpr(SCM sexpr)
{
    SCM ret;
    wchar_t **arr, **ap, *buf;
    
    SCM_ASSERT(SCM_STRINGP(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
    if((buf = icmbstowcs(SCM_STRING_CHARS(sexpr), NULL)) == 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_INUMP(version), version, SCM_ARG2, "dc-checkproto");
	ver = SCM_INUM(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);
    free(data);
    return(sizeof(*data));
}

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_MAKINUM(data->resp->tag), port);
    scm_puts(" ", port);
    scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
    scm_puts(" ", port);
    scm_display(SCM_MAKINUM(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_MAKINUM(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 {
12383d48	55	SCM_ASSERT(SCM_STRINGP(host), host, SCM_ARG1, "dc-connect");
12383d48	56	chost = SCM_STRING_CHARS(host);
d3372da9	57	}
12383d48	58	if((fd = dc_connect(chost)) < 0)
d3372da9	59	scm_syserror("dc-connect");
	60	return(SCM_MAKINUM(fd));
	61	}
	62
	63	static SCM scm_dc_disconnect(void)
	64	{
	65	dc_disconnect();
	66	return(SCM_MAKINUM(0));
	67	}
	68
	69	static SCM scm_dc_connected(void)
	70	{
	71	return((fd == -1)?SCM_BOOL_F:SCM_BOOL_T);
	72	}
	73
	74	static SCM scm_dc_select(SCM timeout)
	75	{
	76	struct pollfd pfd;
	77	int cto, ret, enob;
	78
	79	if(timeout == SCM_UNDEFINED)
	80	{
	81	cto = -1;
	82	} else {
	83	SCM_ASSERT(SCM_INUMP(timeout), timeout, SCM_ARG1, "dc-select");
	84	cto = SCM_INUM(timeout);
	85	}
	86	if(fd < 0)
	87	scm_syserror_msg("dc-select", "Not connected", SCM_EOL, ENOTCONN);
	88	pfd.fd = fd;
	89	pfd.events = POLLIN;
	90	if(dc_wantwrite())
	91	pfd.events \|= POLLOUT;
	92	if((ret = poll(&pfd, 1, cto)) < 0)
	93	{
	94	if(errno == EINTR)
	95	return(SCM_BOOL_F);
	96	enob = errno;
	97	dc_disconnect();
	98	errno = enob;
	99	scm_syserror("dc-select");
	100	}
	101	if(((pfd.revents & POLLIN) && dc_handleread()) \|\| ((pfd.revents & POLLOUT) && dc_handlewrite()))
	102	{
	103	if(errno == 0)
	104	{
	105	fd = -1;
	106	return(SCM_BOOL_F);
	107	}
	108	scm_syserror("dc-select");
	109	}
	110	return(ret?SCM_BOOL_T:SCM_BOOL_F);
	111	}
	112
	113	static SCM makerespsmob(struct dc_response *resp)
	114	{
	115	struct respsmob *data;
	116
	117	data = scm_must_malloc(sizeof(*data), "respsmob");
	118	data->resp = resp;
	119	SCM_RETURN_NEWSMOB(resptype, data);
	120	}
	121
	122	static SCM scm_dc_getresp(SCM tag)
123	{
124	struct dc_response *resp;
125	SCM ret;
126
127	if(tag == SCM_UNDEFINED)
128	{
129	if((resp = dc_getresp()) == NULL)
130	return(SCM_BOOL_F);
131	} else {
132	SCM_ASSERT(SCM_INUMP(tag), tag, SCM_ARG1, "dc-getresp");
133	if((resp = dc_gettaggedresp(SCM_INUM(tag))) == NULL)
134	return(SCM_BOOL_F);
135	}
136	ret = makerespsmob(resp);
137	return(ret);
138	}
139
140	static SCM scm_dc_extract(SCM scm_resp)
141	{
142	int i, o;
143	struct dc_response *resp;
144	SCM ret, l, w;
145
146	SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-extract");
147	resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
148	ret = SCM_EOL;
149	ret = scm_cons(scm_cons(scm_str2symbol("cmd"), scm_makfrom0str(icswcstombs(resp->cmdname, "UTF-8", NULL))), ret);
150	ret = scm_cons(scm_cons(scm_str2symbol("code"), SCM_MAKINUM(resp->code)), ret);
151	ret = scm_cons(scm_cons(scm_str2symbol("tag"), SCM_MAKINUM(resp->tag)), ret);
152	l = SCM_EOL;
153	for(i = resp->numlines - 1; i >= 0; i--)
154	{
155	w = SCM_EOL;
156	for(o = resp->rlines[i].argc - 1; o >= 0; o--)
157	w = scm_cons(scm_makfrom0str(icswcstombs(resp->rlines[i].argv[o], "UTF-8", NULL)), w);
158	l = scm_cons(w, l);
159	}
160	ret = scm_cons(scm_cons(scm_str2symbol("resp"), l), ret);
161	return(ret);
162	}
163
164	static SCM scm_dc_intresp(SCM scm_resp)
165	{
166	int i;
167	struct dc_response *resp;
168	struct dc_intresp *ires;
169	SCM ret;
170
171	SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, scm_resp), scm_resp, SCM_ARG1, "dc-intresp");
172	resp = ((struct respsmob *)SCM_SMOB_DATA(scm_resp))->resp;
173	if((ires = dc_interpret(resp)) == NULL)
174	return(SCM_BOOL_F);
175	ret = SCM_EOL;
176	for(i = ires->argc - 1; i >= 0; i--)
177	{
178	switch(ires->argv[i].type)
179	{
180	case 1:
181	ret = scm_cons(scm_makfrom0str(icswcstombs(ires->argv[i].val.str, "UTF-8", NULL)), ret);
182	break;
183	case 2:
184	ret = scm_cons(scm_int2num(ires->argv[i].val.num), ret);
185	break;
186	case 3:
187	ret = scm_cons(scm_double2num(ires->argv[i].val.flnum), ret);
188	break;
189	}
190	}
191	dc_freeires(ires);
192	return(ret);
193	}
194
195	static int qcmd_scmcb(struct dc_response *resp)
196	{
197	struct scmcb *scmcb;
198
199	scmcb = resp->data;
200	scm_apply(scmcb->subr, scm_cons(makerespsmob(resp), SCM_EOL), SCM_EOL);
201	scm_gc_unprotect_object(scmcb->subr);
202	free(scmcb);
203	return(2);
204	}
205
206	static SCM scm_dc_qcmd(SCM argv, SCM callback)
207	{
208	int tag, enob;
209	wchar_t *toks, tok, *cmd;
210	size_t tokssize, toksdata;
211	SCM port;
212	struct scmcb *scmcb;
213
214	SCM_ASSERT(SCM_CONSP(argv), argv, SCM_ARG1, "dc-qcmd");
215	if(callback != SCM_UNDEFINED)
216	SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG2, "dc-qcmd");
217	cmd = NULL;
218	toks = NULL;
219	tokssize = toksdata = 0;
220	for(; argv != SCM_EOL; argv = SCM_CDR(argv))
221	{
222	port = scm_open_output_string();
223	scm_display(SCM_CAR(argv), port);
224	if((tok = icmbstowcs(SCM_STRING_CHARS(scm_get_output_string(port)), "UTF-8")) == NULL)
225	{
226	enob = errno;
227	addtobuf(toks, NULL);
228	dc_freewcsarr(toks);
229	if(cmd != NULL)
230	free(cmd);
231	errno = enob;
232	scm_syserror("dc-qcmd");
233	}
234	if(cmd == NULL)
235	cmd = tok;
236	else
237	addtobuf(toks, tok);
238	}
239	addtobuf(toks, NULL);
240	if(callback == SCM_UNDEFINED)
241	{
0931eb36	242	tag = dc_queuecmd(NULL, NULL, cmd, L"%a", toks, NULL);
d3372da9	243	} else {
	244	scmcb = scm_must_malloc(sizeof(*scmcb), "scmcb");
	245	scm_gc_protect_object(scmcb->subr = callback);
0931eb36	246	tag = dc_queuecmd(qcmd_scmcb, scmcb, cmd, L"%a", toks, NULL);
d3372da9	247	}
	248	dc_freewcsarr(toks);
	249	if(cmd != NULL)
	250	free(cmd);
	251	return(SCM_MAKINUM(tag));
	252	}
	253
	254	static void login_scmcb(int err, wchar_t reason, struct scmcb scmcb)
	255	{
	256	SCM errsym;
	257
	258	switch(err)
	259	{
	260	case DC_LOGIN_ERR_SUCCESS:
	261	errsym = scm_str2symbol("success");
	262	break;
	263	case DC_LOGIN_ERR_NOLOGIN:
	264	errsym = scm_str2symbol("nologin");
	265	break;
	266	case DC_LOGIN_ERR_SERVER:
	267	errsym = scm_str2symbol("server");
	268	break;
	269	case DC_LOGIN_ERR_USER:
	270	errsym = scm_str2symbol("user");
	271	break;
	272	case DC_LOGIN_ERR_CONV:
	273	errsym = scm_str2symbol("conv");
	274	break;
	275	case DC_LOGIN_ERR_AUTHFAIL:
	276	errsym = scm_str2symbol("authfail");
	277	break;
	278	}
	279	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);
	280	scm_gc_unprotect_object(scmcb->subr);
	281	free(scmcb);
	282	}
	283
	284	static SCM scm_dc_loginasync(SCM callback, SCM useauthless, SCM username)
	285	{
	286	struct scmcb *scmcb;
	287
	288	SCM_ASSERT(SCM_CLOSUREP(callback), callback, SCM_ARG1, "dc-loginasync");
	289	scmcb = scm_must_malloc(sizeof(*scmcb), "scmcb");
	290	scm_gc_protect_object(scmcb->subr = callback);
	291	dc_loginasync(SCM_STRINGP(username)?SCM_STRING_CHARS(username):NULL, SCM_NFALSEP(useauthless), NULL, (void ()(int, wchar_t , void *))login_scmcb, scmcb);
	292	return(SCM_BOOL_T);
	293	}
	294
	295	static SCM scm_dc_lexsexpr(SCM sexpr)
	296	{
	297	SCM ret;
	298	wchar_t arr, ap, *buf;
	299
	300	SCM_ASSERT(SCM_STRINGP(sexpr), sexpr, SCM_ARG1, "dc-lexsexpr");
	301	if((buf = icmbstowcs(SCM_STRING_CHARS(sexpr), NULL)) == NULL)
	302	scm_syserror("dc-lexsexpr");
	303	arr = dc_lexsexpr(buf);
	304	free(buf);
	305	ret = SCM_EOL;
	306	if(arr != NULL)
	307	{
	308	for(ap = arr; *ap != NULL; ap++)
	309	ret = scm_cons(scm_makfrom0str(icswcstombs(*ap, "UTF-8", NULL)), ret);
	310	dc_freewcsarr(arr);
311	}
312	return(scm_reverse(ret));
313	}
314
9cbeb60c	315	static SCM scm_dc_checkproto(SCM resp, SCM version)
	316	{
	317	int ver;
	318
	319	SCM_ASSERT(SCM_SMOB_PREDICATE(resptype, resp), resp, SCM_ARG1, "dc-checkproto");
	320	if(version == SCM_UNDEFINED)
	321	{
	322	ver = DC_LATEST;
	323	} else {
	324	SCM_ASSERT(SCM_INUMP(version), version, SCM_ARG2, "dc-checkproto");
	325	ver = SCM_INUM(version);
	326	}
	327	if(dc_checkprotocol(((struct respsmob *)SCM_SMOB_DATA(resp))->resp, ver))
	328	return(SCM_BOOL_F);
	329	else
	330	return(SCM_BOOL_T);
	331	}
	332
d3372da9	333	static size_t resp_free(SCM respsmob)
	334	{
	335	struct respsmob *data;
	336
	337	data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
	338	dc_freeresp(data->resp);
	339	free(data);
	340	return(sizeof(*data));
	341	}
	342
	343	static int resp_print(SCM respsmob, SCM port, scm_print_state *pstate)
	344	{
	345	struct respsmob *data;
	346
	347	data = (struct respsmob *)SCM_SMOB_DATA(respsmob);
	348	scm_puts("#<dc-response ", port);
	349	scm_display(SCM_MAKINUM(data->resp->tag), port);
	350	scm_puts(" ", port);
	351	scm_puts(icswcstombs(data->resp->cmdname, "UTF-8", NULL), port);
	352	scm_puts(" ", port);
	353	scm_display(SCM_MAKINUM(data->resp->code), port);
	354	scm_puts(">", port);
	355	return(1);
	356	}
	357
	358	void init_guiledc(void)
	359	{
12383d48	360	scm_c_define_gsubr("dc-connect", 0, 1, 0, scm_dc_connect);
d3372da9	361	scm_c_define_gsubr("dc-disconnect", 0, 0, 0, scm_dc_disconnect);
	362	scm_c_define_gsubr("dc-connected", 0, 0, 0, scm_dc_connected);
	363	scm_c_define_gsubr("dc-select", 0, 1, 0, scm_dc_select);
	364	scm_c_define_gsubr("dc-getresp", 0, 1, 0, scm_dc_getresp);
	365	scm_c_define_gsubr("dc-extract", 1, 0, 0, scm_dc_extract);
	366	scm_c_define_gsubr("dc-intresp", 1, 0, 0, scm_dc_intresp);
	367	scm_c_define_gsubr("dc-qcmd", 1, 1, 0, scm_dc_qcmd);
	368	scm_c_define_gsubr("dc-loginasync", 2, 1, 0, scm_dc_loginasync);
	369	scm_c_define_gsubr("dc-lexsexpr", 1, 0, 0, scm_dc_lexsexpr);
9cbeb60c	370	scm_c_define_gsubr("dc-checkproto", 1, 1, 0, scm_dc_checkproto);
9cbeb60c	371	scm_c_define("dc-latest", SCM_MAKINUM(DC_LATEST));
d3372da9	372	resptype = scm_make_smob_type("dc-resp", sizeof(struct respsmob));
	373	scm_set_smob_free(resptype, resp_free);
	374	scm_set_smob_print(resptype, resp_print);
	375	dc_init();
	376	}