void
scm_assert_foreign_object_type (SCM type, SCM val)
{
if (!SCM_IS_A_P (val, type))
scm_error (scm_arg_type_key, NULL, "Wrong type (expecting ~A): ~S",
scm_list_2 (scm_class_name (type), val), scm_list_1 (val));
}
void test_free_handle_slist_option (SCM option)
{
SCM handle = cl_easy_init();
SCM str_list = scm_list_2(scm_from_locale_string("foo"), scm_from_locale_string("bar"));
SCM ret = cl_easy_setopt(handle, scm_variable_ref(option), str_list, SCM_BOOL_F);
gc_free_handle(handle);
}
int test_can_convert_to_slist__slist (void)
{
SCM str_list = scm_list_2(scm_from_locale_string("foo"), scm_from_locale_string("bar"));
int ret = _scm_can_convert_to_slist (str_list);
printf("test that _scm_can_convert_to_slist returns 1 when passed a list of strings: %d\n", ret == 1);
return ret == 1;
}
int test_can_convert_to_slist__list_of_integers (void)
{
SCM str_list = scm_list_2(scm_from_int(1), scm_from_int(2));
int ret = _scm_can_convert_to_slist (str_list);
printf("test that _scm_can_convert_to_slist returns 0 when passed a list of integers: %d\n", ret == 0);
return ret == 0;
}
int test_scm_convert_to_slist__slist (void)
{
SCM str_list = scm_list_2(scm_from_locale_string("foo"), scm_from_locale_string("bar"));
struct curl_slist *ret = _scm_convert_to_slist (str_list);
printf("test that _scm_convert_to_slist returns an slist when passed a list of strings: %d\n", ret != NULL);
return ret != NULL;
}
/*! \brief Evaluate a string as a Scheme expression safely
* \par Function Description
*
* Evaluates a string similarly to scm_eval_string(), but catching
* any errors or exceptions and reporting them via the libgeda
* logging mechanism.
*
* See also g_scm_eval_protected() and g_scm_c_eval_string_protected().
*
* \param str String to evaluate.
*
* \returns Evaluation results or SCM_BOOL_F if exception caught.
*/
SCM g_scm_eval_string_protected (SCM str)
{
SCM expr = scm_list_2 (scm_from_utf8_symbol ("eval-string"),
str);
return g_scm_eval_protected (expr, SCM_UNDEFINED);
}
static void
syntax_error (const char* const msg, const SCM form, const SCM expr)
{
SCM msg_string = scm_from_locale_string (msg);
SCM filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F;
const char *format;
SCM args;
if (scm_is_pair (form))
{
filename = scm_source_property (form, scm_sym_filename);
linenr = scm_source_property (form, scm_sym_line);
}
if (scm_is_false (filename) && scm_is_false (linenr) && scm_is_pair (expr))
{
filename = scm_source_property (expr, scm_sym_filename);
linenr = scm_source_property (expr, scm_sym_line);
}
if (!SCM_UNBNDP (expr))
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S in expression ~S.";
args = scm_list_5 (filename, linenr, msg_string, form, expr);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S in expression ~S.";
args = scm_list_4 (linenr, msg_string, form, expr);
}
else
{
format = "~A ~S in expression ~S.";
args = scm_list_3 (msg_string, form, expr);
}
}
else
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S.";
args = scm_list_4 (filename, linenr, msg_string, form);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S.";
args = scm_list_3 (linenr, msg_string, form);
}
else
{
format = "~A ~S.";
args = scm_list_2 (msg_string, form);
}
}
scm_error (syntax_error_key, "memoization", format, args, SCM_BOOL_F);
}
static void
check_flag (MuFlags flag, FlagData *fdata)
{
SCM flag_scm;
if (!(fdata->flags & flag))
return;
switch (flag) {
case MU_FLAG_NEW: flag_scm = SYMB_FLAG_NEW; break;
case MU_FLAG_PASSED: flag_scm = SYMB_FLAG_PASSED; break;
case MU_FLAG_REPLIED: flag_scm = SYMB_FLAG_REPLIED; break;
case MU_FLAG_SEEN: flag_scm = SYMB_FLAG_SEEN; break;
case MU_FLAG_TRASHED: flag_scm = SYMB_FLAG_TRASHED; break;
case MU_FLAG_SIGNED: flag_scm = SYMB_FLAG_SIGNED; break;
case MU_FLAG_DRAFT: flag_scm = SYMB_FLAG_DRAFT; break;
case MU_FLAG_FLAGGED: flag_scm = SYMB_FLAG_FLAGGED; break;
case MU_FLAG_ENCRYPTED: flag_scm = SYMB_FLAG_ENCRYPTED; break;
case MU_FLAG_HAS_ATTACH: flag_scm = SYMB_FLAG_HAS_ATTACH; break;
case MU_FLAG_UNREAD: flag_scm = SYMB_FLAG_UNREAD; break;
default: flag_scm = SCM_UNDEFINED;
}
fdata->lst = scm_append_x
(scm_list_2(fdata->lst,
scm_list_1 (flag_scm)));
}
static int
pyscm_PySCM_setattr(pyscm_PySCMObject *self, char *name, PyObject *v)
{
/* Set attribute 'name' to value 'v'. v==NULL means delete */
if (pyguile_verbosity_test(PYGUILE_VERBOSE_PYSCM)) {
scm_simple_format(scm_current_output_port(),scm_makfrom0str("# pyscm_PySCM_setattr: trying to set attribute=~S from pobj=~S to value ~S\n"),scm_list_3(scm_makfrom0str(name),verbosity_repr((PyObject *)self),verbosity_repr(v)));
}
SCM sobj_keyword;
SCM sattr_vector = retrieve_sattr_vector(self,name,&sobj_keyword);
if (SCM_UNBNDP(sattr_vector)) {
// Attribute error exception was raised by retrieve_sattr_vector().
return(-1);
}
SCM ssetattr_func = GET_H_SETATTR_FUNC(sattr_vector);
if (SCM_EQ_P(SCM_EOL,ssetattr_func)) {
PyErr_SetString(PyExc_AttributeError, name);
return(-1);
}
if (NULL != v) {
SCM sval = p2g_apply(v,
GET_H_P2G_SETATTR_TEMPLATE(sattr_vector));
scm_append_x(scm_list_2(sobj_keyword,sval));
}
SCM sresult = scm_apply(ssetattr_func,sobj_keyword,SCM_EOL);
return(SCM_EQ_P(SCM_BOOL_F,sresult) ? (-1) : 0);
}
void
scm_assert_foreign_object_type (SCM type, SCM val)
{
/* FIXME: Add fast path for when type == struct vtable */
if (!SCM_IS_A_P (val, type))
scm_error (scm_arg_type_key, NULL, "Wrong type (expecting ~A): ~S",
scm_list_2 (scm_class_name (type), val), scm_list_1 (val));
}
SCM g_scm_c_get_uref (OBJECT *object)
{
SCM func = scm_variable_ref (scm_c_lookup ("get-uref"));
SCM object_smob = edascm_from_object (object);
SCM exp = scm_list_2 (func, object_smob);
return g_scm_eval_protected (exp, SCM_UNDEFINED);
}
static PyObject *load_wrapper(PyObject *name_arg)
{
return scm2py(
scm_eval(
scm_list_2(scm_from_utf8_symbol("load"),
py2scm(name_arg)),
scm_current_module()));
}
SCM g_scm_c_get_uref (TOPLEVEL *toplevel, OBJECT *object)
{
SCM func = scm_variable_ref (scm_c_lookup ("get-uref"));
SCM object_smob = g_make_object_smob (toplevel, object);
SCM exp = scm_list_2 (func, object_smob);
return g_scm_eval_protected (exp, SCM_UNDEFINED);
}
SCM DLL_PUBLIC
cl_easy_perform (SCM handle, SCM bvflag, SCM headerflag)
{
handle_post_t *c_handle;
SCM data;
CURLcode status;
struct scm_flag body_sf, header_sf;
SCM_ASSERT (_scm_is_handle (handle), handle, SCM_ARG1, "%curl-easy-perform");
c_handle = _scm_to_handle (handle);
body_sf.flag = scm_is_true (bvflag);
#if SCM_MAJOR_VERSION == 2
if (body_sf.flag)
data = scm_c_make_bytevector (0);
else
data = scm_c_make_string (0, SCM_MAKE_CHAR('\n'));
#else
data = scm_c_make_string (0, SCM_MAKE_CHAR('\n'));
#endif
body_sf.scm = data;
header_sf.flag = 0;
#if SCM_MAJOR_VERSION == 2
if (header_sf.flag)
data = scm_c_make_bytevector (0);
else
data = scm_c_make_string (0, SCM_MAKE_CHAR('\n'));
#else
data = scm_c_make_string (0, SCM_MAKE_CHAR('\n'));
#endif
header_sf.scm = data;
if (scm_is_true (headerflag))
{
curl_easy_setopt (c_handle->handle, CURLOPT_HEADERFUNCTION, write_callback);
curl_easy_setopt (c_handle->handle, CURLOPT_HEADERDATA, &header_sf);
curl_easy_setopt (c_handle->handle, CURLOPT_ERRORBUFFER, error_string);
}
curl_easy_setopt (c_handle->handle, CURLOPT_WRITEFUNCTION, write_callback);
curl_easy_setopt (c_handle->handle, CURLOPT_WRITEDATA, &body_sf);
curl_easy_setopt (c_handle->handle, CURLOPT_ERRORBUFFER, error_string);
/* Do the transfer, and fill c_str with the result */
status = curl_easy_perform (c_handle->handle);
if (status != CURLE_OK)
{
error_code = status;
return (SCM_BOOL_F);
}
if (scm_is_true (headerflag))
return (scm_list_2 (header_sf.scm, body_sf.scm));
return (body_sf.scm);
}
VISIBLE SCM
scm_rexp_interval (SCM match, SCM subexpression)
{
rexp_interval_t interv = rexp_interval (scm_to_rexp_match_t (match),
scm_to_size_t (subexpression));
return ((interv.i_start == -1) ?
SCM_BOOL_F : scm_list_2 (scm_from_int (interv.i_start),
scm_from_int (interv.i_end)));
}
/* Return the range of the lines in the scroll region */
SCM
gucu_getscrreg (SCM win)
{
int top, bottom;
wgetscrreg (_scm_to_window (win), &top, &bottom);
return (scm_list_2 (scm_from_int (top), scm_from_int (bottom)));
}
/* Get the location of the virtual screen cursor */
SCM
gucu_getsyx ()
{
int y = 0, x = 0;
getsyx (y, x);
return (scm_list_2 (scm_from_int (y), scm_from_int (x)));
}
SCM
gucu_getyx (SCM win)
{
int y, x;
getyx (_scm_to_window (win), y, x);
return (scm_list_2 (scm_from_int (y), scm_from_int (x)));
}
SCM
gram_keydown_hook_run (void *data)
{
struct keydown_input* input = (struct keydown_input*) data;
scm_c_run_hook (gram_keydown_hook,
scm_list_2 (gram_keysym_scm (&input->keysym),
gram_view_scm(input->view)));
return gram_swallow ? SCM_BOOL_T : SCM_BOOL_F;
}
SCM
gram_view_focus_hook_run (void *data)
{
struct view_focus_input *input = (struct view_focus_input *) data;
scm_c_run_hook (gram_view_focus_hook,
scm_list_2 (gram_view_scm (input->handle),
input->focus ? SCM_BOOL_T : SCM_BOOL_F));
return SCM_UNSPECIFIED;
}
SCM TTY::GetWinSize(SCM id){
assert_object_type(id);
TTY * t = (TTY *)get_object(id);
assert(t!=NULL);
int width = 0;
int height = 0;
int r = uv_tty_get_winsize(GetHandle(t), &width, &height);
if(r) Logger::Err("uv_tty_get_winsize failed! : %d", r);
return scm_list_2(scm_from_int(width), scm_from_int(height));
}
static AVCodecContext *open_codec(SCM scm_self, AVCodecContext *codec_ctx, AVCodec *codec,
const char *media_type, SCM scm_file_name)
{
int err = avcodec_open2(codec_ctx, codec, NULL);
if (err < 0) {
ffmpeg_destroy(scm_self);
scm_misc_error("open-codec", "Failed to open ~a codec for file '~a'",
scm_list_2(scm_from_locale_string(media_type), scm_file_name));
};
return codec_ctx;
}
static void guilePropertyListenerCallback(guihckContext* ctx, guihckElementId listenerId, guihckElementId listenedId, const char* property, SCM value, void* data)
{
(void) listenedId;
(void) property;
guihckStackPushElement(ctx, listenerId);
SCM callback = data;
guihckGuileRunExpression(ctx, scm_list_2(callback, value));
guihckStackPopElement(ctx);
}
SCM dijkstra(SCM scm_weights, SCM scm_start, SCM scm_cut_corners_p) {
int row = scm_to_int(SCM_CAR(scm_start));
int col = scm_to_int(SCM_CAR(SCM_CDR(scm_start)));
SCM dimensions = scm_array_dimensions(scm_weights);
int rows = scm_to_int(SCM_CAR(dimensions));
int cols = scm_to_int(SCM_CAR(SCM_CDR(dimensions)));
int cut_corners_p = scm_to_bool(scm_cut_corners_p);
int * weights = calloc(rows * cols, sizeof(int *));
WeightedPoint ** weighted_paths = calloc(rows, sizeof(WeightedPoint *));
scm_t_array_handle weights_handle;
scm_array_get_handle(scm_weights, &weights_handle);
int i_row, i_col;
for(i_row = 0; i_row < rows; i_row++) {
weighted_paths[i_row] = calloc(cols, sizeof(WeightedPoint));
for(i_col = 0; i_col < cols; i_col++) {
ssize_t pos = scm_array_handle_pos(&weights_handle, scm_list_2(scm_from_int(i_row), scm_from_int(i_col)));
weights[i_row * cols + i_col] = scm_to_int(scm_array_handle_ref(&weights_handle, pos));
}
}
scm_array_handle_release(&weights_handle);
find_paths(weighted_paths, (Point){col, row}, cut_corners_p, weights, rows, cols);
SCM scm_paths = scm_make_array(scm_from_int(0), dimensions);
for(i_row = 0; i_row < rows; i_row++) {
for(i_col = 0; i_col < cols; i_col++) {
scm_array_set_x(scm_paths,
scm_list_2(scm_from_int(weighted_paths[i_row][i_col].prev.y), scm_from_int(weighted_paths[i_row][i_col] .prev.x)),
scm_list_2(scm_from_int(i_row), scm_from_int(i_col)));
}
free(weighted_paths[i_row]);
}
free(weighted_paths);
free(weights);
return scm_paths;
}
static SCM
gdbscm_memory_port_range (SCM port)
{
ioscm_memory_port *iomem;
SCM_ASSERT_TYPE (gdbscm_is_memory_port (port), port, SCM_ARG1, FUNC_NAME,
memory_port_desc_name);
iomem = (ioscm_memory_port *) SCM_STREAM (port);
return scm_list_2 (gdbscm_scm_from_ulongest (iomem->start),
gdbscm_scm_from_ulongest (iomem->end));
}
static SCM scm_all_clients(void)
{
SCM clients = SCM_EOL;
SCM smob;
client_t *client = client_list;
while (client) {
SCM_NEWSMOB(smob, client_tag, client);
clients = scm_append(scm_list_2(clients, scm_list_1(smob)));
client = client->next;
}
return clients;
}
static AVCodecContext *open_decoder(SCM scm_self, SCM scm_file_name,
AVStream *stream, const char *media_type)
{
AVCodecContext *dec_ctx = stream->codec;
AVCodec *decoder = avcodec_find_decoder(dec_ctx->codec_id);
if (!decoder) {
ffmpeg_destroy(scm_self);
scm_misc_error("open-codec", "Failed to find ~a codec for file '~a'",
scm_list_2(scm_from_locale_string(media_type), scm_file_name));
};
return open_codec(scm_self, dec_ctx, decoder, media_type, scm_file_name);
}
static SCM
gdbscm_open_memory (SCM rest)
{
const SCM keywords[] = {
mode_keyword, start_keyword, size_keyword, SCM_BOOL_F
};
char *mode = NULL;
CORE_ADDR start = 0;
CORE_ADDR end;
int mode_arg_pos = -1, start_arg_pos = -1, size_arg_pos = -1;
ULONGEST size;
SCM port;
long mode_bits;
gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "#sUU", rest,
&mode_arg_pos, &mode,
&start_arg_pos, &start,
&size_arg_pos, &size);
scm_dynwind_begin ((scm_t_dynwind_flags) 0);
if (mode == NULL)
mode = xstrdup ("r");
scm_dynwind_free (mode);
if (size_arg_pos > 0)
{
/* For now be strict about start+size overflowing. If it becomes
a nuisance we can relax things later. */
if (start + size < start)
{
gdbscm_out_of_range_error (FUNC_NAME, 0,
scm_list_2 (gdbscm_scm_from_ulongest (start),
gdbscm_scm_from_ulongest (size)),
_("start+size overflows"));
}
end = start + size;
}
else
end = ~(CORE_ADDR) 0;
mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode);
port = ioscm_open_port (memory_port_desc, mode_bits);
ioscm_init_memory_port (port, start, end);
scm_dynwind_end ();
/* TODO: Set the file name as "memory-start-end"? */
return port;
}
static void x_window_invoke_macro(GtkEntry *entry, void *userdata)
{
GSCHEM_TOPLEVEL *w_current = userdata;
SCM interpreter;
interpreter = scm_list_2(scm_from_utf8_symbol("invoke-macro"),
scm_from_utf8_string(gtk_entry_get_text(entry)));
g_scm_eval_protected(interpreter, SCM_UNDEFINED);
gtk_widget_hide(w_current->macro_box);
gtk_widget_grab_focus(w_current->drawing_area);
}
SCM
gucu_slk_attr ()
{
attr_t rendition, attributes;
short color_pair_number;
rendition = slk_attr ();
attributes = rendition;
attributes &= A_ATTRIBUTES ^ A_COLOR;
color_pair_number = PAIR_NUMBER (rendition & A_COLOR);
return scm_list_2 (_scm_from_attr (attributes),
scm_from_short (color_pair_number));
}
