SCM usb_device(SCM name)
{
	io_iterator_t iterator = 0;
	
	CFDictionaryRef matchDict = IOServiceMatching(kIOUSBDeviceClassName);
	IOServiceGetMatchingServices(kIOMasterPortDefault, matchDict, &iterator);

	io_service_t device;
	int cnt = 0;
	
	int found_device = false;

	while(device = IOIteratorNext(iterator))
	{
		io_name_t dev_name;

		if(IORegistryEntryGetName(device, dev_name) == KERN_SUCCESS)
			if(!strncmp(dev_name,scm_to_locale_string(name),strlen(scm_to_locale_string(name))))
				found_device = true;
		
		IOObjectRelease(device);

		++cnt;
	}
	
	IOObjectRelease(iterator);
	
	return scm_from_int(found_device);
}

SCM script_ogre_create_entity(SCM s_name, SCM s_mesh_path)
{
  const char *name      = scm_to_locale_string(s_name),
             *mesh_path = scm_to_locale_string(s_mesh_path);

  uint64_t ret = ogre_create_entity(name, mesh_path);
  return scm_from_uint64(ret);
}

SCM tf_set_attr_string(SCM scm_description, SCM scm_name, SCM scm_value)
{
  struct tf_description_t *self = get_tf_description(scm_description);
  char *name = scm_to_locale_string(scm_name);
  char *value = scm_to_locale_string(scm_value);
  TF_SetAttrString(self->description, name, value, scm_c_string_length(scm_value));
  free(value);
  free(name);
  return SCM_UNDEFINED;
}

SCM make_description(SCM scm_graph, SCM scm_op, SCM scm_name)
{
  SCM retval;
  struct tf_graph_t *graph = get_tf_graph(scm_graph);
  struct tf_description_t *self = (struct tf_description_t *)scm_gc_calloc(sizeof(struct tf_description_t), "make-description");
  SCM_NEWSMOB(retval, tf_description_tag, self);
  char *op = scm_to_locale_string(scm_op);
  char *name = scm_to_locale_string(scm_name);
  self->description = TF_NewOperation(graph->graph, op, name);
  free(name);
  free(op);
  return retval;
}

static SCM unpatch_out(SCM left, SCM right) {
	char source[64];
	char *dest;
	if (jack_client == NULL) return SCM_BOOL_F;
	dest = scm_to_locale_string(left);
	sprintf(source, "%s:out%02d", client_name, 1);
	jack_disconnect(jack_client, source, dest);
	free(dest);
	dest = scm_to_locale_string(right);
	sprintf(source, "%s:out%02d", client_name, 2);
	jack_disconnect(jack_client, source, dest);
	free(dest);
	return SCM_BOOL_T;
	}

SCM tf_graph_import_(SCM scm_graph, SCM scm_file_name)
{
  struct tf_graph_t *graph = get_tf_graph(scm_graph);
  char *file_name = scm_to_locale_string(scm_file_name);
  FILE *file = fopen(file_name, "r");
  free(file_name);
  if (!file)
    scm_misc_error("tf-graph-import_", strerror(errno), SCM_EOL);
  int fd = fileno(file);
  struct stat st;
  fstat(fd, &st);
  size_t size = st.st_size;
  TF_Buffer *buffer = TF_NewBuffer();
  void *data = scm_gc_malloc(size, "tf-graph-import_");
  fread(data, size, 1, file);
  buffer->data = data;
  buffer->length = size;
  fclose(file);
  TF_ImportGraphDefOptions* opts = TF_NewImportGraphDefOptions();
  TF_GraphImportGraphDef(graph->graph, buffer, opts, status());
  TF_DeleteImportGraphDefOptions(opts);
  TF_DeleteBuffer(buffer);
  if (TF_GetCode(_status) != TF_OK)
    scm_misc_error("tf-graph-import_", TF_Message(_status), SCM_EOL);
  return SCM_UNDEFINED;
}

static SCM
decode_scm_col_list (GttGhtml *ghtml, SCM col_list)
{
	SCM col_name;
	char * tok = NULL;

	/* reset the parser */
	ghtml->ninvl_cols = 0;
	ghtml->ntask_cols = 0;
		
	while (!scm_is_null (col_list))
	{
		col_name = SCM_CAR (col_list);

		/* either a 'symbol or a "quoted string" */
		if (!scm_is_symbol(col_name) && !scm_is_string (col_name))
		{
			col_list = SCM_CDR (col_list);
			continue;
		}
		tok = scm_to_locale_string (col_name);
		decode_column (ghtml, tok);

		free (tok);
		col_list = SCM_CDR (col_list);
	}

	return SCM_UNSPECIFIED;
}

/********************************************************************\
 * gnc_get_credit_string                                            *
 *   return a credit string for a given account type                *
 *                                                                  *
 * Args: account_type - type of account to get credit string for    *
 * Return: g_malloc'd credit string or NULL                         *
\********************************************************************/
char *
gnc_get_credit_string(GNCAccountType account_type)
{
    const gchar *string;
    SCM result;
    SCM arg;

    initialize_scm_functions();

    if (gnc_gconf_get_bool(GCONF_GENERAL, KEY_ACCOUNTING_LABELS, NULL))
        return g_strdup(_("Credit"));

    if ((account_type < ACCT_TYPE_NONE) || (account_type >= NUM_ACCOUNT_TYPES))
        account_type = ACCT_TYPE_NONE;

    arg = scm_long2num(account_type);

    result = scm_call_1(getters.credit_string, arg);
    if (!scm_is_string(result))
        return NULL;

    string = scm_to_locale_string(result);
    if (string)
        return g_strdup(string);
    return NULL;
}

static SCM make_doc(SCM ingredients, SCM recipe) {
	MAKE_NODE *node;
	FILE_NODE *fnode;
	SCM smob, cursor;
	if (scm_is_symbol(ingredients)) {
		if (ingredients == file_sym) {
			node = make_node(TYPE_FILE);
			node->filepath = scm_to_locale_string(recipe);
			node->dirty = 1;
			fnode = (FILE_NODE *)malloc(sizeof(FILE_NODE));
			fnode->node = node;
			fnode->mtime = 0;
			fnode->next = file_nodes;
			file_nodes = fnode;
			}
		else {
			node = make_node(TYPE_DATUM);
			node->dirty = 0;
			node->payload = recipe;
			}
		SCM_RETURN_NEWSMOB(make_node_tag, node);
		}
	node = make_node(TYPE_CHAIN);
	node->dirty = 1;
	node->callback = recipe;
	SCM_NEWSMOB(smob, make_node_tag, node);
	cursor = ingredients;
	while (cursor != SCM_EOL) {
		add_ascendant(SCM_CAR(cursor), smob);
		cursor = SCM_CDR(cursor);
		}
	scm_remember_upto_here_2(ingredients, recipe);
	scm_remember_upto_here_2(smob, cursor);
	return smob;
	}

SCM Event::On(SCM e, SCM cb){
  CheckArgType(e, scm_string_p, "event-on", 1);
  CheckArgType(cb, scm_procedure_p, "event-on", 2);
  string ev = scm_to_locale_string(e);
  events_g->On(ev, cb);
  return e;
}

SCM
guile_comm_init (SCM args) // MPI_Init
{
    int argc, i;
    char **argv;

    // count number of arguments:
    argc = scm_to_int (scm_length (args));

    argv = malloc ((argc + 1) * sizeof (char *));

    argv[argc] = NULL;

    for (i = 0; i < argc; i++)
      {
        argv[i] = scm_to_locale_string (scm_car (args));
        args = scm_cdr (args);
      }

    int ierr = MPI_Init (&argc, &argv);
    assert (MPI_SUCCESS==ierr);

    /* FIXME:  In fact  we dont  know  if MPI_Init  replaced the  argv
       completely   and   who  is   responsible   for  freeing   these
       resources. So we do not attempt to free them. */

    return scm_from_comm (MPI_COMM_WORLD);
}

/* We assume that data is actually a char**. The way we return results
 * from this function is to malloc a fresh string, and store it in
 * this pointer. It is the caller's responsibility to do something
 * smart with this freshly allocated storage. the caller can determine
 * whether there was an error by initializing the char* passed in to
 * NULL. If there is an error, the char string will not be NULL on
 * return. */
static SCM
gfec_catcher(void *data, SCM tag, SCM throw_args)
{
    SCM func;
    SCM result;
    const char *msg = NULL;

    func = scm_c_eval_string("gnc:error->string");
    if (scm_is_procedure(func))
    {
        result = scm_call_2(func, tag, throw_args);
        if (scm_is_string(result))
        {
            char * str;

            scm_dynwind_begin (0); 
            str = scm_to_locale_string (result);
            msg = g_strdup (str);
            scm_dynwind_free (str); 
            scm_dynwind_end (); 
        }
    }

    if (msg == NULL)
    {
        msg = "Error running guile function.";
    }

    *(char**)data = strdup(msg);

    return SCM_UNDEFINED;
}

SCM
set_thread_name (SCM name)
{
  char *n = scm_to_locale_string (name);
  prctl (PR_SET_NAME, n);
  return SCM_UNDEFINED;
}

struct t_hashtable *
weechat_guile_alist_to_hashtable (SCM alist, int size, const char *type_keys,
                                  const char *type_values)
{
    struct t_hashtable *hashtable;
    int length, i;
    SCM pair;
    char *str, *str2;

    hashtable = weechat_hashtable_new (size,
                                       type_keys,
                                       type_values,
                                       NULL,
                                       NULL);
    if (!hashtable)
        return NULL;

    length = scm_to_int (scm_length (alist));
    for (i = 0; i < length; i++)
    {
        pair = scm_list_ref (alist, scm_from_int (i));
        if (strcmp (type_values, WEECHAT_HASHTABLE_STRING) == 0)
        {
            str = scm_to_locale_string (scm_list_ref (pair, scm_from_int (0)));
            str2 = scm_to_locale_string (scm_list_ref (pair, scm_from_int (1)));
            weechat_hashtable_set (hashtable, str, str2);
            if (str)
                free (str);
            if (str2)
                free (str2);
        }
        else if (strcmp (type_values, WEECHAT_HASHTABLE_POINTER) == 0)
        {
            str = scm_to_locale_string (scm_list_ref (pair, scm_from_int (0)));
            str2 = scm_to_locale_string (scm_list_ref (pair, scm_from_int (1)));
            weechat_hashtable_set (hashtable, str,
                                   plugin_script_str2ptr (weechat_guile_plugin,
                                                          NULL, NULL, str2));
            if (str)
                free (str);
            if (str2)
                free (str2);
        }
    }

    return hashtable;
}

static void
load_extension (SCM lib, SCM init)
{
  extension_t *head;

  scm_i_pthread_mutex_lock (&ext_lock);
  head = registered_extensions;
  scm_i_pthread_mutex_unlock (&ext_lock);

  /* Search the registry. */
  if (head != NULL)
    {
      extension_t *ext;
      char *clib, *cinit;
      int found = 0;

      scm_dynwind_begin (0);

      clib = scm_to_locale_string (lib);
      scm_dynwind_free (clib);
      cinit = scm_to_locale_string (init);
      scm_dynwind_free (cinit);

      for (ext = head; ext; ext = ext->next)
	if ((ext->lib == NULL || !strcmp (ext->lib, clib))
	    && !strcmp (ext->init, cinit))
	  {
	    ext->func (ext->data);
            found = 1;
	    break;
	  }

      scm_dynwind_end ();

      if (found)
        return;
    }

  /* Dynamically link the library. */
#if HAVE_MODULES
  scm_dynamic_call (init, scm_dynamic_link (lib));
#else
  scm_misc_error ("load-extension",
                  "extension ~S:~S not registered and dynamic-link disabled",
                  scm_list_2 (init, lib));
#endif
}

SCM tf_set_attr_bool(SCM scm_description, SCM scm_name, SCM scm_value)
{
  struct tf_description_t *self = get_tf_description(scm_description);
  char *name = scm_to_locale_string(scm_name);
  TF_SetAttrBool(self->description, name, scm_is_true(scm_value));
  free(name);
  return SCM_UNDEFINED;
}

SCM scheme_write_to_stderr(SCM output)
{
    char *str = scm_to_locale_string(output);
    fprintf(stderr, "%s", str);
    free(str);

    return SCM_UNSPECIFIED;
}

SCM tf_set_attr_float(SCM scm_description, SCM scm_name, SCM scm_value)
{
  struct tf_description_t *self = get_tf_description(scm_description);
  char *name = scm_to_locale_string(scm_name);
  TF_SetAttrFloat(self->description, name, (float)scm_to_double(scm_value));
  free(name);
  return SCM_UNDEFINED;
}

SCM llvm_get_function_address(SCM scm_llvm, SCM scm_name)
{
  struct llvm_module_t *self = get_llvm(scm_llvm);
  char *name = scm_to_locale_string(scm_name);
  void *address = (void *)LLVMGetFunctionAddress(self->engine, name);
  free(name);
  return scm_from_pointer(address, NULL);
}

SCM script_ogre_create_child_scene_node(SCM s_parent, SCM s_name)
{
  void *parent = (void*)scm_to_uint64(s_parent);
  const char *name = scm_to_locale_string(s_name);

  uint64_t ret = ogre_create_child_scene_node(parent, name);
  return scm_from_uint64(ret);
}