SWIGINTERN int
SWIG_Guile_GetArgs (SCM *dest, SCM rest,
int reqargs, int optargs,
const char *procname)
{
int i;
int num_args_passed = 0;
for (i = 0; i<reqargs; i++) {
if (!SCM_CONSP(rest))
scm_wrong_num_args(scm_from_locale_string((char *) procname));
*dest++ = SCM_CAR(rest);
rest = SCM_CDR(rest);
num_args_passed++;
}
for (i = 0; i<optargs && SCM_CONSP(rest); i++) {
*dest++ = SCM_CAR(rest);
rest = SCM_CDR(rest);
num_args_passed++;
}
for (; i<optargs; i++)
*dest++ = SCM_UNDEFINED;
if (!SCM_NULLP(rest))
scm_wrong_num_args(scm_from_locale_string((char *) procname));
return num_args_passed;
}
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;
}
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;
}
/* Scheme interface to scm_error_scm. */
void
scm_error (SCM key, const char *subr, const char *message, SCM args, SCM rest)
{
scm_error_scm
(key,
(subr == NULL) ? SCM_BOOL_F : scm_from_locale_string (subr),
(message == NULL) ? SCM_BOOL_F : scm_from_locale_string (message),
args, rest);
}
VISIBLE void
scm_gsl_error_handler_for_raising_a_gsl_error (const char *reason,
const char *file,
int line, int gsl_errno)
{
scm_raise_gsl_error (scm_list_4 (scm_from_locale_string (reason),
scm_from_locale_string (file),
scm_from_int (line),
scm_from_int (gsl_errno)));
}
static SCM wrap_musicpd_server_version(void) {
char *s = musicpd_server_version();
if(s)
return scm_from_locale_string(s);
return SCM_BOOL_F;
}
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);
}
/*! \brief Enable scheme loading from a shared data directory
* \par Function Description
* Helper function for g_register_libgeda_dirs().
*/
static void
g_register_scheme_data_dir (const gchar *data_dir)
{
gchar *scheme_dir = g_build_filename (data_dir, "scheme", NULL);
g_rc_scheme_directory (scm_from_locale_string (scheme_dir));
g_free (scheme_dir);
}
static void *
sysdep_dynl_link_global (const char *fname, const char *subr)
{
lt_dlhandle handle;
handle = dlopenext_global (fname);
if (NULL == handle)
{
SCM fn;
SCM msg;
fn = scm_from_locale_string (fname);
msg = scm_from_locale_string (lt_dlerror ());
scm_misc_error (subr, "file: ~S, message: ~S", scm_list_2 (fn, msg));
}
return (void *) handle;
}
void
__test_query_g_db_handle(gdbi_db_handle_t* dbh, char* query)
{
dbh->status = (SCM) scm_cons(scm_from_int(0),
scm_from_locale_string("test query ok"));
return;
}
static SCM alsa_cards(void) {
// compile list of available cards
int card;
char buf[32];
char *pt;
SCM list, alist;
snd_ctl_card_info_t *info;
snd_ctl_card_info_alloca(&info);
card = -1;
list = SCM_EOL;
while (1) {
if ((snd_card_next(&card) < 0) || (card < 0)) break;
sprintf(buf, "hw:%d", card);
alist = SCM_EOL;
alist = scm_assq_set_x(alist, SYM("dev"),
scm_from_locale_string(buf));
snd_card_get_name(card, &pt);
alist = scm_assq_set_x(alist, SYM("name"),
scm_take_locale_string(pt));
list = scm_cons(alist, list);
scm_remember_upto_here_1(alist);
}
scm_remember_upto_here_1(list);
return list;
}
SCM
yacl_scm_gen_p256_key_pair (void)
{
int rc;
uint8_t q[YACL_P256_COORD_SIZE*2];
uint8_t d[YACL_P256_COORD_SIZE];
rc = yacl_create_key_pair(q, d);
SCM qs = scm_c_make_bytevector (YACL_SHA256_LEN*2);
SCM ds = scm_c_make_bytevector (YACL_SHA256_LEN);
memcpy (SCM_BYTEVECTOR_CONTENTS (qs), &q, YACL_SHA256_LEN*2);
memcpy (SCM_BYTEVECTOR_CONTENTS (ds), &d, YACL_SHA256_LEN);
SCM q_list = scm_list_2 (scm_from_locale_symbol ("q"), qs);
SCM d_list = scm_list_2 (scm_from_locale_symbol ("d"), ds);
SCM curve_list = scm_list_2 (scm_from_locale_symbol ("curve"),
scm_from_locale_string("NIST P-256"));
SCM l = scm_list_4 (scm_from_locale_symbol ("ecc"),
curve_list,
q_list,
d_list);
SCM pri_key = scm_list_2 (scm_from_locale_symbol ("private-key"),
l);
return pri_key;
}
static AVCodec *find_encoder(SCM scm_self, enum AVCodecID codec_id, const char *output_type)
{
if (codec_id == AV_CODEC_ID_NONE) {// TODO: test (needs wav or mp3 container selection above first)
ffmpeg_destroy(scm_self);
scm_misc_error("make-ffmpeg-output", "File format does not support ~a encoding",
scm_list_1(scm_from_locale_string(output_type)));
};
AVCodec *retval = avcodec_find_encoder(codec_id);// TODO: autodetect or select video codec
if (!retval) {
ffmpeg_destroy(scm_self);
scm_misc_error("make-ffmpeg-output", "Error finding encoder for codec '~a'",
scm_list_1(scm_from_locale_string(avcodec_descriptor_get(codec_id)->name)));
};
return retval;
}
void test_free_handle_string_postfields(void)
{
extern SCM cl_CURLOPT_POSTFIELDS;
SCM handle = cl_easy_init();
SCM str = scm_from_locale_string("abcdefghijklmnopqrstuvwxyz");
SCM ret = cl_easy_setopt(handle, scm_variable_ref(cl_CURLOPT_POSTFIELDS), str, SCM_BOOL_F);
gc_free_handle(handle);
}
void
react_to_terminal_signal (int sig)
{
enum { EXPLEN = 25 };
char exp[EXPLEN];
snprintf (exp, EXPLEN, "(handle-signal %d)", sig);
scm_eval_string (scm_from_locale_string (exp));
exit (1);
}
void
__test_close_g_db_handle(gdbi_db_handle_t* dbh)
{
dbh->db_info = NULL;
dbh->status = (SCM) scm_cons(scm_from_int(0),
scm_from_locale_string("test close ok"));
dbh->closed = SCM_BOOL_T;
return;
}
void
__test_make_g_db_handle(gdbi_db_handle_t* dbh)
{
if(scm_is_true(scm_string_p(dbh->constr)) == 0)
{
dbh->status = (SCM) scm_cons(scm_from_int(1),
scm_from_locale_string("missing connection string"));
dbh->closed = SCM_BOOL_F;
return;
}
else
{
dbh->status = (SCM) scm_cons(scm_from_int(0),
scm_from_locale_string("test connect ok"));
dbh->closed = SCM_BOOL_T;
}
return;
}
static SCM wrap_player_version(void) {
char s[8];
snprintf(s, 8, "%i.%i", GEIRVARTA_V_MAJOR, GEIRVARTA_V_MINOR);
if(*s)
return scm_from_locale_string(s);
return SCM_BOOL_F;
}
SCM tf_operation_names_(SCM scm_graph)
{
SCM retval = SCM_EOL;
struct tf_graph_t *graph = get_tf_graph(scm_graph);
size_t pos = 0;
TF_Operation *oper;
while(oper = TF_GraphNextOperation(graph->graph, &pos))
retval = scm_cons(scm_from_locale_string(TF_OperationName(oper)), retval);
return retval;
}
void
weechat_guile_hashtable_map_cb (void *data,
struct t_hashtable *hashtable,
const char *key,
const char *value)
{
SCM *alist, pair, list;
/* make C compiler happy */
(void) hashtable;
alist = (SCM *)data;
pair = scm_cons (scm_from_locale_string (key),
scm_from_locale_string (value));
list = scm_list_1 (pair);
*alist = scm_append (scm_list_2 (*alist, list));
}
static void *
sysdep_dynl_value (const char *symb, void *handle, const char *subr)
{
void *fptr;
fptr = lt_dlsym ((lt_dlhandle) handle, symb);
if (!fptr)
scm_misc_error (subr, "Symbol not found: ~a",
scm_list_1 (scm_from_locale_string (symb)));
return fptr;
}
SCM llvm_verify_module(SCM scm_llvm)
{
struct llvm_module_t *llvm = get_llvm(scm_llvm);
char *error = NULL;
if (LLVMVerifyModule(llvm->module, LLVMPrintMessageAction, &error)) {
SCM scm_error = scm_from_locale_string(error);
LLVMDisposeMessage(error);
scm_misc_error("verify-module", "Module is not valid: ~a", scm_list_1(scm_error));
};
return SCM_UNSPECIFIED;
}
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;
}
SCM
gucu_slk_label (SCM labnum)
{
SCM_ASSERT (scm_is_integer (labnum), labnum, SCM_ARG1, "slk-label");
int c_labnum = scm_to_int (labnum);
char *ret = slk_label (c_labnum);
SCM s_ret = scm_from_locale_string (ret);
return s_ret;
}
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);
}
/*! \brief Get input files from command line.
* \par Function Description
* This function returns a list of the files named on the command line.
*
* \return A list of filenames as strings.
*/
SCM g_get_input_files()
{
SCM list = SCM_EOL;
GSList *current = input_files;
while (current != NULL) {
list = scm_cons (scm_from_locale_string (current->data), list);
current = g_slist_next(current);
}
return scm_reverse_x (list, SCM_EOL);
}
static AVStream *open_output_stream(SCM scm_self, AVCodec *encoder, int *stream_idx, const char *output_type, SCM scm_file_name)
{
struct ffmpeg_t *self = get_self(scm_self);
AVStream *retval = avformat_new_stream(self->fmt_ctx, encoder);
if (!retval) {
ffmpeg_destroy(scm_self);
scm_misc_error("make-ffmpeg-output", "Error allocating ~a stream for file '~a'",
scm_list_2(scm_from_locale_string(output_type), scm_file_name));
};
retval->id = self->fmt_ctx->nb_streams - 1;
*stream_idx = retval->id;
return retval;
}
static void x_window_invoke_macro(GtkEntry *entry, void *userdata)
{
GSCHEM_TOPLEVEL *w_current = userdata;
SCM interpreter;
interpreter = scm_list_2(scm_from_locale_symbol("invoke-macro"),
scm_from_locale_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);
}
/*! \brief Obtain a list of `-O' backend arguments.
* \par Function Description
* Returns a list of arguments passed to the gnetlist backend via the
* `-O' gnetlist command-line option.
*/
SCM
g_get_backend_arguments()
{
SCM result = SCM_EOL;
GSList *iter;
for (iter = backend_params; iter != NULL; iter = g_slist_next (iter)) {
result = scm_cons (scm_from_locale_string ((char *) iter->data),
result);
}
return scm_reverse_x (result, SCM_UNDEFINED);
}
