SCM scm_mmr_sleep(SCM second ,SCM msecond)
#define FUNC_NAME "ragnarok-sleep"
{
long s = 0L;
long ms = 0L;
SCM_VALIDATE_NUMBER(1 ,second);
s = scm_to_long(second);
if(!SCM_UNBNDP(msecond))
{
SCM_VALIDATE_NUMBER(2 ,msecond);
ms = scm_to_long(msecond);
}
if(s)
{
sleep(s);
}
if(ms)
{
usleep(ms);
}
return SCM_BOOL_T;
}
SCM scm_ragnarok_epoll_wait(SCM event_set ,SCM second ,SCM msecond)
#define FUNC_NAME "ragnarok-epoll-wait"
{
scm_rag_epoll_event_set *es = NULL;
int fd;
int op;
int count;
long s = 0L;
long ms = 0L;
SCM cons;
int nfds;
SCM ret = SCM_EOL;
SCM_ASSERT_EPOLL_EVENT_SET(event_set);
es = (scm_rag_epoll_event_set*)SCM_SMOB_DATA(event_set);
if(!SCM_UNBNDP(second))
{
SCM_VALIDATE_NUMBER(3 ,second);
s = (long)scm_to_long(second);
if(!SCM_UNBNDP(msecond))
{
SCM_VALIDATE_NUMBER(4 ,msecond);
ms = (long)scm_to_long(msecond);
}
ms += s*1000; // convert to mseconds since epoll_wait only accept msecond;
}
ms = ms ? ms : -1;
count = es->count;
if(!count)
goto end;
nfds = epoll_wait(es->epfd ,es->ee_set ,count ,ms);
if(nfds < 0)
{
RAG_ERROR1("epoll_wait" ,"epoll_wait error! errno shows %a~%",
RAG_ERR2STR(errno));
}
while(nfds > 0)
{
nfds--;
fd = es->ee_set[nfds].data.fd;
op = es->ee_set[nfds].events;
cons = scm_cons(scm_from_int(fd) ,scm_from_int(op));
ret = scm_cons(cons ,ret);
}
return ret;
end:
return SCM_EOL;
}
SCM DLL_PUBLIC
cl_easy_setopt (SCM handle, SCM option, SCM param, SCM big)
{
handle_post_t *c_handle;
CURLoption c_option;
CURLcode code = CURLE_UNSUPPORTED_PROTOCOL;
SCM_ASSERT (_scm_is_handle (handle), handle, SCM_ARG1, "curl-easy-setopt");
SCM_ASSERT (scm_is_integer (option), option, SCM_ARG2, "curl-easy-setopt");
c_handle = _scm_to_handle (handle);
c_option = (CURLoption) scm_to_int (option);
if (c_option == CURLOPT_POSTFIELDS)
{
if (_scm_can_convert_to_byte_data (param))
{
size_t len;
uint8_t *m = _scm_convert_to_byte_data (param, &len);
free (c_handle->postfields);
c_handle->postfields = m;
curl_easy_setopt (c_handle->handle, CURLOPT_POSTFIELDSIZE, len);
c_handle->postfieldsize = len;
code = curl_easy_setopt (c_handle->handle, CURLOPT_POSTFIELDS, (char *) m);
}
else
scm_error (SCM_BOOL_F, "cl-easy-setopt", "CURLOPT_POSTFIELDS requires 8-bit string or bytevector data",
SCM_BOOL_F, SCM_BOOL_F);
}
else if (c_option == CURLOPT_HTTPHEADER)
{
if (_scm_can_convert_to_slist (param))
{
/* slists require special handling to free them properly, so
they are stored with the Curl handle. */
struct curl_slist *sl = _scm_convert_to_slist (param);
if (c_handle->httpheader)
curl_slist_free_all (c_handle->httpheader);
c_handle->httpheader = sl;
code = curl_easy_setopt (c_handle->handle, CURLOPT_HTTPHEADER, sl);
}
else
scm_error (SCM_BOOL_F, "cl-easy-setopt", "CURLOPT_HTTPHEADER requires a list of strings",
SCM_BOOL_F, SCM_BOOL_F);
}
else if (scm_is_integer (param))
{
if (scm_is_true (big))
code = curl_easy_setopt (c_handle->handle, c_option, scm_to_int64 (param));
else
code = curl_easy_setopt (c_handle->handle, c_option, scm_to_long (param));
}
else if (scm_is_string (param))
{
/* Strings are copied by curl, so they can be freed here. */
char *str;
str = scm_to_locale_string (param);
code = curl_easy_setopt (c_handle->handle, c_option, str);
free (str);
}
else if (_scm_can_convert_to_slist (param))
{
/* slists require special handling to free them properly, so
they are stored with the Curl handle. */
struct curl_slist *sl = _scm_convert_to_slist (param);
int ok = 1;
if (c_option == CURLOPT_HTTP200ALIASES)
{
if (c_handle->http200aliases)
curl_slist_free_all (c_handle->http200aliases);
c_handle->http200aliases = sl;
}
else if (c_option == CURLOPT_MAIL_RCPT)
{
if (c_handle->mail_rcpt)
curl_slist_free_all (c_handle->mail_rcpt);
c_handle->mail_rcpt = sl;
}
else if (c_option == CURLOPT_QUOTE)
{
if (c_handle->quote)
curl_slist_free_all (c_handle->quote);
c_handle->quote = sl;
}
else if (c_option == CURLOPT_POSTQUOTE)
{
if (c_handle->postquote)
curl_slist_free_all (c_handle->postquote);
c_handle->postquote = sl;
}
else if (c_option == CURLOPT_PREQUOTE)
{
if (c_handle->prequote)
curl_slist_free_all (c_handle->prequote);
c_handle->prequote = sl;
}
else if (c_option == CURLOPT_RESOLVE)
{
if (c_handle->resolve)
curl_slist_free_all (c_handle->resolve);
c_handle->resolve = sl;
}
else if (c_option == CURLOPT_TELNETOPTIONS)
{
if (c_handle->telnetoptions)
curl_slist_free_all (c_handle->telnetoptions);
c_handle->telnetoptions = sl;
}
else
{
// Bad slist option
ok = 0;
}
if (ok)
code = curl_easy_setopt (c_handle->handle, c_option, sl);
}
else if (_scm_can_convert_to_httppost (param))
{
if (c_option == CURLOPT_HTTPPOST)
{
struct curl_httppost *p;
p = _scm_convert_to_httppost (param);
free (c_handle->httppost);
c_handle->httppost = p;
code = curl_easy_setopt (c_handle, CURLOPT_HTTPPOST, p);
}
}
else if (scm_is_true (scm_input_port_p (param)))
{
if (c_option == CURLOPT_READDATA)
{
curl_easy_setopt (c_handle->handle, CURLOPT_READFUNCTION, read_callback);
code = curl_easy_setopt (c_handle->handle, CURLOPT_READDATA, SCM2PTR (param));
}
}
else
scm_error (SCM_BOOL_F,
"curl-easy-setopt",
"unimplemented option type",
SCM_BOOL_F,
SCM_BOOL_F);
if (code != CURLE_OK)
scm_error (SCM_BOOL_F,
"curl-easy-setopt",
"bad handle",
SCM_BOOL_F,
SCM_BOOL_F);
return SCM_UNSPECIFIED;
}
static SCM
extract_arg (char format_char, SCM arg, void *argp,
const char *func_name, int position)
{
switch (format_char)
{
case 's':
{
char **arg_ptr = (char **) argp;
CHECK_TYPE (gdbscm_is_true (scm_string_p (arg)), arg, position,
func_name, _("string"));
*arg_ptr = gdbscm_scm_to_c_string (arg);
break;
}
case 't':
{
int *arg_ptr = (int *) argp;
/* While in Scheme, anything non-#f is "true", we're strict. */
CHECK_TYPE (gdbscm_is_bool (arg), arg, position, func_name,
_("boolean"));
*arg_ptr = gdbscm_is_true (arg);
break;
}
case 'i':
{
int *arg_ptr = (int *) argp;
CHECK_TYPE (scm_is_signed_integer (arg, INT_MIN, INT_MAX),
arg, position, func_name, _("int"));
*arg_ptr = scm_to_int (arg);
break;
}
case 'u':
{
int *arg_ptr = (int *) argp;
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT_MAX),
arg, position, func_name, _("unsigned int"));
*arg_ptr = scm_to_uint (arg);
break;
}
case 'l':
{
long *arg_ptr = (long *) argp;
CHECK_TYPE (scm_is_signed_integer (arg, LONG_MIN, LONG_MAX),
arg, position, func_name, _("long"));
*arg_ptr = scm_to_long (arg);
break;
}
case 'n':
{
unsigned long *arg_ptr = (unsigned long *) argp;
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, ULONG_MAX),
arg, position, func_name, _("unsigned long"));
*arg_ptr = scm_to_ulong (arg);
break;
}
case 'L':
{
LONGEST *arg_ptr = (LONGEST *) argp;
CHECK_TYPE (scm_is_signed_integer (arg, INT64_MIN, INT64_MAX),
arg, position, func_name, _("LONGEST"));
*arg_ptr = gdbscm_scm_to_longest (arg);
break;
}
case 'U':
{
ULONGEST *arg_ptr = (ULONGEST *) argp;
CHECK_TYPE (scm_is_unsigned_integer (arg, 0, UINT64_MAX),
arg, position, func_name, _("ULONGEST"));
*arg_ptr = gdbscm_scm_to_ulongest (arg);
break;
}
case 'O':
{
SCM *arg_ptr = (SCM *) argp;
*arg_ptr = arg;
break;
}
default:
gdb_assert_not_reached ("invalid argument format character");
}
return SCM_BOOL_F;
}
PyObject *scm2py(SCM value)
{
if (value == NULL)
return NULL;
if (value == SCM_UNSPECIFIED) {
Py_INCREF(Py_None);
return Py_None;
}
if (scm_is_exact_integer(value))
return PyInt_FromLong(scm_to_long(value));
if (scm_is_real(value))
return PyFloat_FromDouble(scm_to_double(value));
if (scm_is_bool(value)) {
PyObject *result = scm_to_bool(value) ? Py_True : Py_False;
Py_INCREF(result);
return result;
}
if (value == SCM_EOL)
return PyTuple_New(0);
if (scm_is_string(value)) {
size_t len = 0;
char *s = scm_to_utf8_stringn(value, &len);
PyObject *result = PyUnicode_FromStringAndSize(s, len);
free(s);
return result;
}
if (scm_is_pair(value)) {
unsigned int len = scm_to_uint(scm_length(value));
PyObject *result = PyTuple_New(len);
scm_dynwind_begin(0);
scm_dynwind_unwind_handler(
(void (*)(void *))Py_DecRef, result, 0);
unsigned int i;
for (i = 0; i < len; i++) {
PyObject *item = scm2py(scm_car(value));
if (item == NULL) {
scm_dynwind_end();
Py_DECREF(result);
return NULL;
}
PyTuple_SET_ITEM(result, i, item);
value = scm_cdr(value);
}
scm_dynwind_end();
return result;
}
if (scm_to_bool(scm_procedure_p(value))) {
SCM ptr = scm_assq_ref(gsubr_alist, value);
if (!scm_is_false(ptr)) {
PyObject *result = scm_to_pointer(ptr);
Py_INCREF(result);
return result;
}
Procedure *result =
(Procedure *)ProcedureType.tp_alloc(&ProcedureType, 0);
if (result == NULL)
return NULL;
result->proc = value;
return (PyObject *)result;
}
char *msg = scm_to_utf8_stringn(
scm_simple_format(
SCM_BOOL_F,
scm_from_utf8_string(
"Guile expression ~S doesn't have a "
"corresponding Python value"),
scm_list_1(value)), NULL);
PyErr_SetString(PyExc_TypeError, msg);
free(msg);
return NULL;
}
SCM i_set_zoom_wrapper(SCM scale){
return scm_from_bool(i_set_zoom(scm_to_long(scale)));
}
SCM i_navigate_frame_wrapper(SCM n){
return scm_from_bool(i_navigate_frame(scm_to_long(n)));
}