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

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