/*! \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; }