/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_funcs_filesel(SCM scm_msg, SCM scm_templ, SCM scm_flags)
{
int c_flags;
char *r, *msg, *templ;
SCM v;
SCM_ASSERT (scm_is_string (scm_msg), scm_msg,
SCM_ARG1, "gschem-filesel");
SCM_ASSERT (scm_is_string (scm_templ), scm_templ,
SCM_ARG2, "gschem-filesel");
/*! \bug FIXME -- figure out the magic SCM_ASSERT for the flags */
/*! \bug FIXME -- how to deal with conflicting flags?
* Should I throw a scheme error? Just deal in the c code?
*/
for (c_flags = 0; scm_is_pair (scm_flags); scm_flags = SCM_CDR (scm_flags)) {
char *flag;
SCM scm_flag = SCM_CAR (scm_flags);
flag = scm_to_utf8_string (scm_flag);
if (strcmp (flag, "may_exist") == 0) {
c_flags |= FSB_MAY_EXIST;
} else if (strcmp (flag, "must_exist") == 0) {
c_flags |= FSB_MUST_EXIST;
} else if (strcmp (flag, "must_not_exist") == 0) {
c_flags |= FSB_SHOULD_NOT_EXIST;
} else if (strcmp (flag, "save") == 0) {
c_flags |= FSB_SAVE;
} else if (strcmp (flag, "open") == 0) {
c_flags |= FSB_LOAD;
} else {
free(flag);
scm_wrong_type_arg ("gschem-filesel", SCM_ARG3, scm_flag);
}
free(flag);
}
msg = scm_to_utf8_string (scm_msg);
templ = scm_to_utf8_string (scm_templ);
r = generic_filesel_dialog (msg, templ, c_flags);
free(msg);
free(templ);
v = scm_from_utf8_string (r);
g_free (r);
return v;
}
static SCM api_set_header(SCM s_, SCM key_, SCM value_)
{
servlet *s = scm_to_pointer(s_);
char *key = scm_to_utf8_string(key_);
char *value = scm_to_utf8_string(value_);
set_header(s, key, value);
free(key);
free(value);
return SCM_UNSPECIFIED;
}
/*! \brief
* \par Function Description
*
* \param [in] path
* \param [in] name Optional descriptive name for library directory.
* \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
*/
SCM g_rc_component_library(SCM path, SCM name)
{
gchar *string;
char *temp;
char *namestr = NULL;
SCM_ASSERT (scm_is_string (path), path,
SCM_ARG1, "component-library");
if (name != SCM_UNDEFINED) {
SCM_ASSERT (scm_is_string (name), name,
SCM_ARG2, "component-library");
namestr = scm_to_utf8_string (name);
}
/* take care of any shell variables */
temp = scm_to_utf8_string (path);
string = s_expand_env_variables (temp);
free (temp);
/* invalid path? */
if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
fprintf(stderr,
"Invalid path [%s] passed to component-library\n",
string);
if (namestr != NULL) {
free (namestr);
}
g_free(string);
return SCM_BOOL_F;
}
if (g_path_is_absolute (string)) {
s_clib_add_directory (string, namestr);
} else {
gchar *cwd = g_get_current_dir ();
gchar *temp;
temp = g_build_filename (cwd, string, NULL);
s_clib_add_directory (temp, namestr);
g_free(temp);
g_free(cwd);
}
if (namestr != NULL) {
free (namestr);
}
g_free(string);
return SCM_BOOL_T;
}
SCM guileKeyCode(SCM keyName)
{
char* keyNameStr;
if(scm_is_symbol(keyName))
keyNameStr = scm_to_utf8_string(scm_symbol_to_string(keyName));
else if(scm_is_string(keyName))
keyNameStr = scm_to_utf8_string(keyName);
else
assert(false && "Key name must be a symbol or a string");
guihckKey keyCode = guihckContextGetKeyCode(threadLocalContext.ctx, keyNameStr);
free(keyNameStr);
return scm_from_int32(keyCode);
}
/*! \brief Get symbol data from a Scheme-based component source.
* \par Function Description
* Get symbol data from a Scheme-based component source. The return
* value should be free()'d when no longer needed.
*
* Private function used only in s_clib.c.
*
* \param symbol Symbol to get data for.
* \return Allocated buffer containing symbol data.
*/
static gchar *get_data_scm (const CLibSymbol *symbol)
{
SCM symdata;
char *tmp;
gchar *result;
g_return_val_if_fail ((symbol != NULL), NULL);
g_return_val_if_fail ((symbol->source->type == CLIB_SCM), NULL);
symdata = scm_call_1 (symbol->source->get_fn,
scm_from_utf8_string (symbol->name));
if (!scm_is_string (symdata)) {
s_log_message (_("Failed to load symbol data [%1$s] from source [%2$s]"),
symbol->name, symbol->source->name);
return NULL;
}
/* Need to make sure that the correct free() function is called
* on strings allocated by Guile. */
tmp = scm_to_utf8_string (symdata);
result = g_strdup(tmp);
free (tmp);
return result;
}
SCM g_rc_gschlas_version(SCM scm_version)
{
char *version;
SCM ret = SCM_BOOL_T;
SCM_ASSERT (scm_is_string (scm_version), scm_version,
SCM_ARG1, "gschlas-version");
version = scm_to_utf8_string (scm_version);
if (g_strcasecmp (version, PACKAGE_DATE_VERSION) != 0) {
fprintf(stderr,
"You are running gEDA/gaf version [%s%s.%s],\n",
PREPEND_VERSION_STRING, PACKAGE_DOTTED_VERSION,
PACKAGE_DATE_VERSION);
fprintf(stderr,
"but you have a version [%s] gschlasrc file:\n[%s]\n",
version, rc_filename);
fprintf(stderr,
"Please be sure that you have the latest rc file.\n");
ret = SCM_BOOL_F;
}
free (version);
return ret;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_mode_general(SCM scmmode,
const char *rc_name,
int *mode_var,
const vstbl_entry *table,
int table_size)
{
SCM ret;
int index;
char *mode;
SCM_ASSERT (scm_is_string (scmmode), scmmode,
SCM_ARG1, rc_name);
mode = scm_to_utf8_string (scmmode);
index = vstbl_lookup_str(table, table_size, mode);
/* no match? */
if(index == table_size) {
fprintf(stderr,
"Invalid mode [%s] passed to %s\n",
mode,
rc_name);
ret = SCM_BOOL_F;
} else {
*mode_var = vstbl_get_val(table, index);
ret = SCM_BOOL_T;
}
free (mode);
return ret;
}
/*! \todo Finish function description!!!
* \brief
* \par Function Description
*
* \param [in] path
* \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
*/
SCM g_rc_bitmap_directory(SCM path)
{
gchar *string;
char *temp;
SCM_ASSERT (scm_is_string (path), path,
SCM_ARG1, "bitmap-directory");
/* take care of any shell variables */
temp = scm_to_utf8_string (path);
string = s_expand_env_variables (temp);
free (temp);
/* invalid path? */
if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
fprintf (stderr,
"Invalid path [%s] passed to bitmap-directory\n",
string);
g_free(string);
return SCM_BOOL_F;
}
g_free(default_bitmap_directory);
default_bitmap_directory = string;
return SCM_BOOL_T;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_funcs_image(SCM scm_filename)
{
char *filename;
SCM_ASSERT (scm_is_string (scm_filename), scm_filename,
SCM_ARG1, "gschem-image");
GSCHEM_TOPLEVEL *w_current = g_current_window ();
if (output_filename) {
x_image_lowlevel (w_current, output_filename,
w_current->image_width,
w_current->image_height,
g_strdup("png"));
} else {
filename = scm_to_utf8_string (scm_filename);
x_image_lowlevel (w_current, filename,
w_current->image_width,
w_current->image_height,
g_strdup("png"));
free(filename);
}
return SCM_BOOL_T;
}
SCM guihckGuileRunExpression(guihckContext* ctx, SCM expression)
{
threadLocalContext.ctx = ctx;
threadLocalContext.ctxRefs += 1;
SCM result = scm_with_guile(runExpressionInGuile, expression);
#if 0
if(result)
{
char* resultStr = scm_to_utf8_string(scm_object_to_string(result, SCM_UNDEFINED));
printf("RESULT: %s\n", resultStr);
free(resultStr);
}
else
{
printf("RESULT: NULL\n");
}
#endif
threadLocalContext.ctxRefs -= 1;
if(threadLocalContext.ctxRefs <= 0)
{
threadLocalContext.ctx = NULL;
threadLocalContext.ctxRefs = 0;
}
return result;
}
/*! \brief Add a directory to the Guile load path.
* \par Function Description
* Prepends \a s_path to the Guile system '%load-path', after
* expanding environment variables.
*
* \param [in] s_path Path to be added.
* \return SCM_BOOL_T.
*/
SCM g_rc_scheme_directory(SCM s_path)
{
char *temp;
gchar *expanded;
SCM s_load_path_var;
SCM s_load_path;
SCM_ASSERT (scm_is_string (s_path), s_path,
SCM_ARG1, "scheme-directory");
/* take care of any shell variables */
temp = scm_to_utf8_string (s_path);
expanded = s_expand_env_variables (temp);
s_path = scm_from_utf8_string (expanded);
free (temp);
g_free (expanded);
s_load_path_var = scm_c_lookup ("%load-path");
s_load_path = scm_variable_ref (s_load_path_var);
scm_variable_set_x (s_load_path_var, scm_cons (s_path, s_load_path));
scm_remember_upto_here_2 (s_load_path_var, s_load_path);
scm_remember_upto_here_1 (s_path);
return SCM_BOOL_T;
}
/*! \brief Process a Scheme error into the log and/or a GError
* \par Function Description
* Process a captured Guile exception with the given \a s_key and \a
* s_args, and optionally the stack trace \a s_stack. The stack trace
* and source location are logged, and if a GError return location \a
* err is provided, it is populated with an informative error message.
*/
static void
process_error_stack (SCM s_stack, SCM s_key, SCM s_args, GError **err) {
char *long_message;
char *short_message;
SCM s_port, s_subr, s_message, s_message_args, s_rest, s_location;
/* Split s_args up */
s_rest = s_args;
s_subr = scm_car (s_rest); s_rest = scm_cdr (s_rest);
s_message = scm_car (s_rest); s_rest = scm_cdr (s_rest);
s_message_args = scm_car (s_rest); s_rest = scm_cdr (s_rest);
/* Capture short error message */
s_port = scm_open_output_string ();
scm_display_error_message (s_message, s_message_args, s_port);
short_message = scm_to_utf8_string (scm_get_output_string (s_port));
scm_close_output_port (s_port);
/* Capture long error message (including possible backtrace) */
s_port = scm_open_output_string ();
if (scm_is_true (scm_stack_p (s_stack))) {
scm_puts (_("\nBacktrace:\n"), s_port);
scm_display_backtrace (s_stack, s_port, SCM_BOOL_F, SCM_BOOL_F);
scm_puts ("\n", s_port);
}
s_location = SCM_BOOL_F;
#ifdef HAVE_SCM_DISPLAY_ERROR_STACK
s_location = s_stack;
#endif /* HAVE_SCM_DISPLAY_ERROR_STACK */
#ifdef HAVE_SCM_DISPLAY_ERROR_FRAME
s_location =
scm_is_true (s_stack) ? scm_stack_ref (s_stack, SCM_INUM0) : SCM_BOOL_F;
#endif /* HAVE_SCM_DISPLAY_ERROR_FRAME */
scm_display_error (s_location, s_port, s_subr,
s_message, s_message_args, s_rest);
long_message = scm_to_utf8_string (scm_get_output_string (s_port));
scm_close_output_port (s_port);
/* Send long message to log */
s_log_message ("%s", long_message);
/* Populate any GError */
g_set_error (err, EDA_ERROR, EDA_ERROR_SCHEME, "%s", short_message);
}
/*! \todo Finish function description!!!
* \brief
* \par Function Description
*
* \param [in] attrlist
* \return SCM_BOOL_T always.
*/
SCM g_rc_always_promote_attributes(SCM attrlist)
{
GList *list=NULL;
int length, i;
gchar *attr;
gchar **attr2;
g_list_foreach(default_always_promote_attributes, (GFunc)g_free, NULL);
g_list_free(default_always_promote_attributes);
if (scm_is_string (attrlist)) {
char *temp;
s_log_message(_("WARNING: using a string for 'always-promote-attributes'"
" is deprecated. Use a list of strings instead\n"));
/* convert the space separated strings into a GList */
temp = scm_to_utf8_string (attrlist);
attr2 = g_strsplit(temp," ", 0);
free (temp);
for (i=0; attr2[i] != NULL; i++) {
if (strlen(attr2[i]) > 0) {
list = g_list_prepend(list, g_strdup(attr2[i]));
}
}
g_strfreev(attr2);
} else {
SCM_ASSERT(scm_list_p(attrlist), attrlist, SCM_ARG1, "always-promote-attributes");
length = scm_ilength(attrlist);
/* convert the scm list into a GList */
for (i=0; i < length; i++) {
char *temp;
SCM_ASSERT(scm_is_string(scm_list_ref(attrlist, scm_from_int(i))),
scm_list_ref(attrlist, scm_from_int(i)), SCM_ARG1,
"always-promote-attribute: list element is not a string");
temp = scm_to_utf8_string (scm_list_ref (attrlist, scm_from_int (i)));
attr = g_strdup(temp);
free (temp);
list = g_list_prepend(list, attr);
}
}
default_always_promote_attributes = g_list_reverse(list);
return SCM_BOOL_T;
}
/* object being a pin */
char *s_net_return_connected_string(TOPLEVEL * pr_current, OBJECT * object,
char *hierarchy_tag)
{
OBJECT *o_current;
char *pinnum = NULL;
char *uref = NULL;
SCM scm_uref;
char *temp_uref = NULL;
char *string;
char *misc;
o_current = object;
pinnum = o_attrib_search_object_attribs_by_name (o_current, "pinnumber", 0);
#if DEBUG
printf("found pinnum: %s\n", pinnum);
#endif
scm_uref = g_scm_c_get_uref(pr_current, o_current->parent);
if (scm_is_string( scm_uref )) {
temp_uref = scm_to_utf8_string (scm_uref);
}
/* apply the hierarchy name to the uref */
uref = s_hierarchy_create_uref(pr_current, temp_uref, hierarchy_tag);
if (uref && pinnum) {
string = g_strdup_printf("%s %s", uref, pinnum);
} else {
if (pinnum) {
string = g_strdup_printf("POWER %s", pinnum);
} else {
if (hierarchy_tag) {
misc =
s_hierarchy_create_uref(pr_current, "U?",
hierarchy_tag);
string = g_strdup_printf("%s ?", misc);
g_free(misc);
} else {
string = g_strdup("U? ?");
}
fprintf(stderr, "Missing Attributes (refdes and pin number)\n");
}
}
g_free(pinnum);
g_free(uref);
g_free(temp_uref);
return (string);
}
/********************************************************************
* update_report_list
*
* this procedure does the real work of displaying a sorted list of
* available custom reports
********************************************************************/
static void
update_report_list(GtkListStore *store, CustomReportDialog *crd)
{
SCM get_rpt_guids = scm_c_eval_string("gnc:custom-report-template-guids");
SCM template_menu_name = scm_c_eval_string("gnc:report-template-menu-name/report-guid");
SCM rpt_guids;
int i;
GtkTreeIter iter;
GtkTreeModel *model = GTK_TREE_MODEL (store);
gboolean valid_iter;
gtk_tree_sortable_set_sort_column_id(GTK_TREE_SORTABLE(store), COL_NAME, GTK_SORT_ASCENDING);
crd->reportlist = scm_call_0(get_rpt_guids);
rpt_guids = crd->reportlist;
/* Empty current liststore */
valid_iter = gtk_tree_model_get_iter_first (model, &iter);
while (valid_iter)
{
GValue value = { 0, };
GncGUID *row_guid;
g_value_init ( &value, G_TYPE_POINTER);
gtk_tree_model_get_value (model, &iter, COL_NUM, &value);
row_guid = (GncGUID *) g_value_get_pointer (&value);
guid_free (row_guid);
g_value_unset (&value);
valid_iter = gtk_tree_model_iter_next (model, &iter);
}
gtk_list_store_clear(store);
if (scm_is_list(rpt_guids))
{
/* for all the report guids in the list, store them, with a reference,
in the gtkliststore */
for (i = 0; !scm_is_null(rpt_guids); i++)
{
GncGUID *guid = guid_malloc ();
gchar *guid_str = scm_to_utf8_string (SCM_CAR(rpt_guids));
gchar *name = gnc_scm_to_utf8_string (scm_call_2(template_menu_name, SCM_CAR(rpt_guids), SCM_BOOL_F));
if (string_to_guid (guid_str, guid))
{
gtk_list_store_append(store, &iter);
gtk_list_store_set(store, &iter,
COL_NAME, name,
COL_NUM, guid,
-1);
}
g_free (name);
g_free (guid_str);
rpt_guids = SCM_CDR(rpt_guids);
}
}
}
static char *
g_strdup_scm_string(SCM scm_s)
{
char *s, *ret;
s = scm_to_utf8_string (scm_s);
ret = g_strdup (s);
free (s);
return ret;
}
static SCM guileAddPropertyListener(SCM element, SCM keySymbol, SCM callback)
{
char* key = scm_to_utf8_string(scm_symbol_to_string(keySymbol));
guihckElementId listenerId = guihckStackGetElement(threadLocalContext.ctx);
guihckPropertyListenerId id = guihckElementAddListener(threadLocalContext.ctx, listenerId, scm_to_uint64(element), key,
guilePropertyListenerCallback, callback, guilePropertyListenerFreeCallback);
scm_gc_protect_object(callback);
free(key);
return scm_from_uint64(id);
}
/***********************************************************
* gnc_ui_custom_report_edit_name
*
* open the custom report dialog and highlight the given
* report's name for editing.
***********************************************************/
void
gnc_ui_custom_report_edit_name (GncMainWindow * window, SCM scm_guid)
{
SCM is_custom_report;
CustomReportDialog *crd = gnc_ui_custom_report_internal (window);
GtkTreeModel *model;
GtkTreeIter iter;
GncGUID *guid;
gchar *guid_str;
gboolean valid_iter;
is_custom_report = scm_c_eval_string ("gnc:report-template-is-custom/template-guid?");
if (scm_is_false (scm_call_1 (is_custom_report, scm_guid)))
return;
guid = guid_malloc ();
guid_str = scm_to_utf8_string (scm_guid);
if (!string_to_guid (guid_str, guid))
goto cleanup;
/* Look up the row for the requested guid */
model = gtk_tree_view_get_model (GTK_TREE_VIEW (crd->reportview));
valid_iter = gtk_tree_model_get_iter_first (model, &iter);
while (valid_iter)
{
GValue value = { 0, };
GncGUID *row_guid;
gtk_tree_model_get_value (model, &iter, COL_NUM, &value);
row_guid = (GncGUID *) g_value_get_pointer (&value);
if (guid_equal (guid, row_guid))
{
/* We found the row for the requested guid
* Now let's set the report's name cell in edit mode
* so the user can edit the name.
*/
GtkTreePath *path;
GtkTreeSelection *selection = gtk_tree_view_get_selection (GTK_TREE_VIEW (crd->reportview));
gtk_tree_selection_select_iter (selection, &iter);
path = gtk_tree_model_get_path (model, &iter);
g_object_set(G_OBJECT(crd->namerenderer), "editable", TRUE, NULL);
gtk_tree_view_set_cursor_on_cell (GTK_TREE_VIEW (crd->reportview),
path, crd->namecol,
crd->namerenderer, TRUE);
break;
}
g_value_unset (&value);
valid_iter = gtk_tree_model_iter_next (model, &iter);
}
cleanup:
guid_free (guid);
}
/*! \brief Guile callback for adding library commands.
* \par Function Description
* Callback function for the "component-library-command" Guile
* function, which can be used in the rc files to add a command to
* the component library.
*
* \param [in] listcmd command to get a list of symbols
* \param [in] getcmd command to get a symbol from the library
* \param [in] name Optional descriptive name for component source.
* \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
*/
SCM g_rc_component_library_command (SCM listcmd, SCM getcmd,
SCM name)
{
const CLibSource *src;
gchar *lcmdstr, *gcmdstr;
char *tmp_str, *namestr;
SCM_ASSERT (scm_is_string (listcmd), listcmd, SCM_ARG1,
"component-library-command");
SCM_ASSERT (scm_is_string (getcmd), getcmd, SCM_ARG2,
"component-library-command");
SCM_ASSERT (scm_is_string (name), name, SCM_ARG3,
"component-library-command");
scm_dynwind_begin(0);
/* take care of any shell variables */
/*! \bug this may be a security risk! */
tmp_str = scm_to_utf8_string (listcmd);
lcmdstr = s_expand_env_variables (tmp_str);
scm_dynwind_unwind_handler (g_free, lcmdstr, SCM_F_WIND_EXPLICITLY);
free (tmp_str); /* this should stay as free (allocated from guile) */
/* take care of any shell variables */
/*! \bug this may be a security risk! */
tmp_str = scm_to_utf8_string (getcmd);
gcmdstr = s_expand_env_variables (tmp_str);
scm_dynwind_unwind_handler (g_free, gcmdstr, SCM_F_WIND_EXPLICITLY);
free (tmp_str); /* this should stay as free (allocated from guile) */
namestr = scm_to_utf8_string (name);
src = s_clib_add_command (lcmdstr, gcmdstr, namestr);
free (namestr); /* this should stay as free (allocated from guile) */
scm_dynwind_end();
if (src != NULL) return SCM_BOOL_T;
return SCM_BOOL_F;
}
/*! \brief Get attribute value(s) from a package with given uref.
* \par Function Description
* This function returns the values of a specific attribute type
* attached to the symbol instances with the given refdes.
*
* Every first attribute value found is added to the return list. A
* Scheme false value is added if the instance has no such attribute.
*
* \note The order of the values in the return list is the order of
* symbol instances within gnetlist (the first element is the value
* associated with the first symbol instance).
*
* \param [in] scm_uref Package reference.
* \param [in] scm_wanted_attrib Attribute name.
* \return A list of attribute values as strings and #f.
*/
SCM g_get_all_package_attributes(SCM scm_uref, SCM scm_wanted_attrib)
{
SCM ret = SCM_EOL;
NETLIST *nl_current;
char *uref;
char *wanted_attrib;
SCM_ASSERT(scm_is_string (scm_uref),
scm_uref, SCM_ARG1, "gnetlist:get-all-package-attributes");
SCM_ASSERT(scm_is_string (scm_wanted_attrib),
scm_wanted_attrib, SCM_ARG2, "gnetlist:get-all-package-attributes");
uref = scm_to_utf8_string (scm_uref);
wanted_attrib = scm_to_utf8_string (scm_wanted_attrib);
/* here is where you make it multi page aware */
nl_current = netlist_head;
/* search for uref instances and through the entire list */
while (nl_current != NULL) {
if (nl_current->component_uref) {
if (strcmp(nl_current->component_uref, uref) == 0) {
char *value =
o_attrib_search_object_attribs_by_name (nl_current->object_ptr,
wanted_attrib, 0);
ret = scm_cons (value ? scm_from_utf8_string (value) : SCM_BOOL_F, ret);
g_free (value);
}
}
nl_current = nl_current->next;
}
free (uref);
free (wanted_attrib);
return scm_reverse_x (ret, SCM_EOL);
}
static SCM api_get_header(SCM s_, SCM key_)
{
servlet *s = scm_to_pointer(s_);
char *key = scm_to_utf8_string(key_);
const char *value = get_header(s, key);
free(key);
if (value)
{
return scm_from_utf8_string(value);
}
return SCM_UNSPECIFIED;
}
/* Given a uref, Return a list of pairs, each pair contains the name
* of the pin, and the name of the net connected to that pin.
*/
SCM g_get_pins_nets(SCM scm_uref)
{
SCM pinslist = SCM_EOL;
SCM pairlist = SCM_EOL;
NETLIST *nl_current = NULL;
CPINLIST *pl_current = NULL;
char *wanted_uref = NULL;
char *net_name = NULL;
char *pin = NULL;
SCM_ASSERT(scm_is_string (scm_uref),
scm_uref, SCM_ARG1, "gnetlist:get-pins-nets");
wanted_uref = scm_to_utf8_string (scm_uref);
/* search for the any instances */
/* through the entire list */
for (nl_current = netlist_head; nl_current != NULL;
nl_current = nl_current->next) {
/* is there a uref? */
if (nl_current->component_uref) {
/* is it the one we want ? */
if (strcmp(nl_current->component_uref, wanted_uref) == 0) {
for (pl_current = nl_current->cpins; pl_current != NULL;
pl_current = pl_current->next) {
/* is there a valid pin number and a valid name ? */
if (pl_current->pin_number) {
if (pl_current->net_name) {
/* yes, add it to the list */
pin = pl_current->pin_number;
net_name = pl_current->net_name;
pairlist = scm_cons (scm_from_utf8_string (pin),
scm_from_utf8_string (net_name));
pinslist = scm_cons (pairlist, pinslist);
}
}
}
}
}
}
free (wanted_uref);
pinslist = scm_reverse (pinslist); /* pins are in reverse order on the way
* out
*/
return (pinslist);
}
SCM guileGetElementProperty(SCM keySymbol)
{
if(scm_is_symbol(keySymbol))
{
char* key = scm_to_utf8_string(scm_symbol_to_string(keySymbol));
return guihckStackGetElementProperty(threadLocalContext.ctx, key);
}
else
{
return SCM_UNDEFINED;
}
}
static SCM api_get_arg(SCM s_, SCM name_)
{
servlet *s = scm_to_pointer(s_);
char *name = scm_to_utf8_string(name_);
const char *arg = get_arg(s, name);
free(name);
if (arg)
{
return scm_from_utf8_string(arg);
}
return SCM_UNSPECIFIED;
}
/*! \brief Re-poll a scheme procedure for symbols.
* \par Function Description
* Calls a Scheme procedure to obtain a list of available symbols,
* and updates the source with the new list
*
* Private function used only in s_clib.c.
*/
static void refresh_scm (CLibSource *source)
{
SCM symlist;
SCM symname;
CLibSymbol *symbol;
char *tmp;
g_return_if_fail (source != NULL);
g_return_if_fail (source->type == CLIB_SCM);
/* Clear the current symbol list */
g_list_foreach (source->symbols, (GFunc) free_symbol, NULL);
g_list_free (source->symbols);
source->symbols = NULL;
symlist = scm_call_0 (source->list_fn);
if (scm_is_false (scm_list_p (symlist))) {
s_log_message (_("Failed to scan library [%1$s]: Scheme function returned non-list."),
source->name);
return;
}
while (!scm_is_null (symlist)) {
symname = SCM_CAR (symlist);
if (!scm_is_string (symname)) {
s_log_message (_("Non-string symbol name while scanning library [%1$s]"),
source->name);
} else {
symbol = g_new0 (CLibSymbol, 1);
symbol->source = source;
/* Need to make sure that the correct free() function is called
* on strings allocated by Guile. */
tmp = scm_to_utf8_string (symname);
symbol->name = g_strdup(tmp);
free (tmp);
/* Prepend because it's faster and it doesn't matter what order we
* add them. */
source->symbols = g_list_prepend (source->symbols, symbol);
}
symlist = SCM_CDR (symlist);
}
/* Now sort the list of symbols by name. */
source->symbols = g_list_sort (source->symbols,
(GCompareFunc) compare_symbol_name);
s_clib_flush_search_cache();
s_clib_flush_symbol_cache();
}
SCM guilePushElementById(SCM idSymbol)
{
if(scm_is_symbol(idSymbol))
{
char* id = scm_to_utf8_string(scm_symbol_to_string(idSymbol));
guihckStackPushElementById(threadLocalContext.ctx, id);
return SCM_BOOL_T;
}
else
{
return SCM_BOOL_F;
}
}
SCM guilePushNewElement(SCM typeSymbol)
{
if(scm_is_symbol(typeSymbol))
{
char* typeName = scm_to_utf8_string(scm_symbol_to_string(typeSymbol));
guihckStackPushNewElement(threadLocalContext.ctx, typeName);
return SCM_BOOL_T;
}
else
{
return SCM_BOOL_F;
}
}
void* runExpressionInGuile(void* data)
{
SCM expression = data;
#if 0
char* expressionStr = scm_to_utf8_string(scm_object_to_string(expression, SCM_UNDEFINED));
printf("EXPR: %s\n", expressionStr);
free(expressionStr);
#endif
SCM result = scm_primitive_eval(expression);
if(!result)
exit(1);
return result;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_funcs_log(SCM scm_msg)
{
char *msg;
SCM_ASSERT (scm_is_string (scm_msg), scm_msg,
SCM_ARG1, "gschem-log");
msg = scm_to_utf8_string (scm_msg);
s_log_message ("%s", msg);
free(msg);
return SCM_BOOL_T;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_funcs_msg(SCM scm_msg)
{
char *msg;
SCM_ASSERT (scm_is_string (scm_msg), scm_msg,
SCM_ARG1, "gschem-msg");
msg = scm_to_utf8_string (scm_msg);
generic_msg_dialog (msg);
free(msg);
return SCM_BOOL_T;
}
