SCM scm_tls_get_fd(SCM tls_smob){ scm_assert_smob_type(tls_tag, tls_smob); BIO *bio = (BIO*)SCM_SMOB_DATA(tls_smob); int fd = BIO_get_fd(bio, NULL); SCM port = scm_fdopen(scm_from_int(fd), scm_from_utf8_string("r+")); scm_set_port_encoding_x(port, scm_from_utf8_string("UTF-8")); return port; }
SCM mu_guile_g_error (const char *func_name, GError *err) { scm_error_scm (scm_from_locale_symbol ("MuError"), scm_from_utf8_string (func_name), scm_from_utf8_string (err ? err->message : "error"), SCM_UNDEFINED, SCM_UNDEFINED); return SCM_UNSPECIFIED; }
static SCM scm_from_pin (CPINLIST *pin) { return scm_list_n (pin->object_ptr ? edascm_from_object (pin->object_ptr) : SCM_BOOL_F, pin->pin_number ? scm_from_utf8_string (pin->pin_number) : SCM_BOOL_F, pin->net_name ? scm_from_utf8_string (pin->net_name) : SCM_BOOL_F, pin->pin_label ? scm_from_utf8_string (pin->pin_label) : SCM_BOOL_F, scm_from_net_list (pin->nets), SCM_UNDEFINED); }
static SCM scm_from_netlist (NETLIST *netlist) { return scm_list_n (netlist->component_uref ? scm_from_utf8_string (netlist->component_uref) : SCM_BOOL_F, netlist->hierarchy_tag ? scm_from_utf8_string (netlist->hierarchy_tag) : SCM_BOOL_F, scm_from_bool (netlist->composite_component), netlist->object_ptr ? edascm_from_object (netlist->object_ptr) : SCM_BOOL_F, scm_from_pin_list (netlist->cpins), SCM_UNDEFINED); }
SCM mu_guile_error (const char *func_name, int status, const char *fmt, SCM args) { scm_error_scm (scm_from_locale_symbol ("MuError"), scm_from_utf8_string (func_name ? func_name : "<nameless>"), scm_from_utf8_string (fmt), args, scm_list_1 (scm_from_int (status))); 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); }
/*! \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; }
/*! \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; }
/************************************************************** * custom_report_list_view_row_activated_cb * * this is the double-click signal. No need to call * get_custom_report_selection as the double-click implies the * selection. **************************************************************/ void custom_report_list_view_row_activated_cb(GtkTreeView *view, GtkTreePath *path, GtkTreeViewColumn *column, gpointer data) { CustomReportDialog *crd = data; GtkTreeModel *model; GtkTreeIter iter; model = gtk_tree_view_get_model(view); if (gtk_tree_model_get_iter(model, &iter, path)) { if (column == crd->namecol) { GncGUID *guid = guid_malloc (); gchar *guid_str; gtk_tree_model_get(model, &iter, COL_NUM, &guid, -1); guid_str = g_new0 (gchar, GUID_ENCODING_LENGTH+1 ); guid_to_string_buff (guid, guid_str); custom_report_run_report(scm_from_utf8_string (guid_str), crd); } } }
/******************************************************************** * get_custom_report_selection * * this helper function is called to get the selection when the user * clicks on "Run" or "Delete". Includes calling a dialog when there * is no selection. * * const gchar* message -- the message to provide user if there is no * actual selection found. *********************************************************************/ static SCM get_custom_report_selection(CustomReportDialog *crd, const gchar* message) { GtkTreeSelection *sel; GtkTreeModel *model; GtkTreeIter iter; GncGUID *guid = guid_malloc (); gchar *guid_str; sel = gtk_tree_view_get_selection(GTK_TREE_VIEW(crd->reportview)); if (gtk_tree_selection_get_selected(sel, &model, &iter)) { gtk_tree_model_get(model, &iter, COL_NUM, &guid, -1); guid_str = g_new0 (gchar, GUID_ENCODING_LENGTH+1 ); guid_to_string_buff (guid, guid_str); } else { /* no selection, notify user */ gnc_error_dialog (GTK_WINDOW (crd->dialog), "%s", message); return SCM_EOL; } return scm_from_utf8_string (guid_str); }
/* this function will only return a unique list of packages */ SCM g_get_packages(SCM level) { SCM list = SCM_EOL; GHashTable *ht; NETLIST *nl_current = NULL; SCM_ASSERT(scm_is_string (level), level, SCM_ARG1, "gnetlist:get-packages"); /* build a hash table */ ht = g_hash_table_new (g_str_hash, g_str_equal); for (nl_current = netlist_head; nl_current != NULL; nl_current = nl_current->next) { if (nl_current->component_uref != NULL) { /* add component_uref in the hash table */ /* uniqueness of component_uref is guaranteed by the hashtable */ if (g_hash_table_lookup (ht, nl_current->component_uref) == NULL) { g_hash_table_insert (ht, nl_current->component_uref, nl_current->component_uref); list = scm_cons (scm_from_utf8_string (nl_current->component_uref), list); } } } g_hash_table_destroy (ht); return list; }
/*! \brief Load a Scheme file, catching and logging errors. * \par Function Description * Loads \a filename, catching any uncaught errors and logging them. * * \bug Most other functions in the libgeda API return TRUE on success * and FALSE on failure. g_read_file() shouldn't be an exception. * * \param toplevel The TOPLEVEL structure. * \param filename The file name of the Scheme file to load. * \param err Return location for errors, or NULL. * \return TRUE on success, FALSE on failure. */ gboolean g_read_file(TOPLEVEL *toplevel, const gchar *filename, GError **err) { struct g_read_file_data_t data; g_return_val_if_fail ((filename != NULL), FALSE); data.stack = SCM_BOOL_F; data.filename = scm_from_utf8_string (filename); data.err = NULL; scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE); edascm_dynwind_toplevel (toplevel); scm_c_catch (SCM_BOOL_T, (scm_t_catch_body) g_read_file__body, &data, (scm_t_catch_handler) g_read_file__post_handler, &data, (scm_t_catch_handler) g_read_file__pre_handler, &data); scm_dynwind_end (); /* If no error occurred, indicate success. */ if (data.err == NULL) return TRUE; g_propagate_error (err, data.err); return FALSE; }
SCM scm_gunzip_buf(SCM scm_buf, SCM scm_outlen){ //this should typecheck buf for us size_t buflen = scm_c_bytevector_length(scm_buf); uint8_t *buf = (uint8_t*)SCM_BYTEVECTOR_CONTENTS(scm_buf); size_t outlen = scm_to_size_t(scm_outlen); uint8_t *out = scm_gc_malloc_pointerless(outlen, SCM_GC_BYTEVECTOR); z_stream stream = {.next_in = buf, .avail_in = buflen, .next_out = out, .avail_out = outlen, .zalloc = NULL, .zfree = NULL, .opaque = NULL}; //15 | 16 means use 15 bits for the decompression window, and only accept //gzip compressed buffers inflateInit2(&stream, 15 | 16); int status = inflate(&stream, Z_FINISH); if(status != Z_STREAM_END){ //the output buffer was too small //Do something useful here, for now this just makes sure that //we don't cause any errors fprintf(stderr, "Return value was %d, expecting %d\n", status, Z_FINISH); scm_gc_free(out, outlen, SCM_GC_BYTEVECTOR); SCM ret = scm_from_utf8_string(stream.msg); inflateEnd(&stream); return ret; } //I don't know what the tag bits for a bytevector are so I need to //make an empty one. SCM bv = scm_c_make_bytevector(0); SCM_SET_CELL_WORD_1(bv, stream.total_out); SCM_SET_CELL_WORD_2(bv, out); inflateEnd(&stream); return bv; }
SCM gfec_eval_string(const char *str, gfec_error_handler error_handler) { SCM result = SCM_UNDEFINED; SCM func = scm_c_eval_string("gnc:eval-string-with-error-handling"); if (scm_is_procedure(func)) { char *err_msg = NULL; SCM call_result, error = SCM_UNDEFINED; call_result = scm_call_1 (func, scm_from_utf8_string (str)); error = scm_list_ref (call_result, scm_from_uint (1)); if (scm_is_true (error)) err_msg = gnc_scm_to_utf8_string (error); else result = scm_list_ref (call_result, scm_from_uint (0)); if (err_msg != NULL) { if (error_handler) error_handler (err_msg); free(err_msg); } } return result; }
/*! \brief Register some libgeda directories with Scheme. * \par Function Description * Ensures that the default gEDA Scheme directory is added to the * Guile load path. */ void g_register_libgeda_dirs (void) { char *scheme_dir; scheme_dir = g_build_filename (s_path_sys_data (), "scheme", NULL); g_rc_scheme_directory (scm_from_utf8_string (scheme_dir)); g_free (scheme_dir); }
/*! \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_get_method(SCM s_) { servlet *s = scm_to_pointer(s_); const char *method = get_method(s); if (method) { return scm_from_utf8_string(method); } return SCM_UNSPECIFIED; }
VISIBLE SCM scm_rexp_substring (SCM match, SCM string, SCM subexpression) { uint8_t *_string = (uint8_t *) scm_to_utf8_stringn (string, NULL); uint8_t *_substring = u8_rexp_substr (scm_to_rexp_match_t (match), _string, scm_to_size_t (subexpression)); free (_string); return (_substring == NULL) ? SCM_BOOL_F : scm_from_utf8_string ((const char *) _substring); }
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; }
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; }
/*! \brief Register some libgeda variables with scheme. * \par Function Description * Define some variables to be visible to Scheme. */ void g_register_libgeda_vars (void) { scm_c_define("geda-rc-path", scm_from_utf8_string (s_path_sys_config ())); scm_c_define("geda-data-path", scm_from_utf8_string (s_path_sys_data ())); scm_c_define("path-sep", scm_from_utf8_string(G_DIR_SEPARATOR_S)); scm_c_define("OBJ_LINE", SCM_MAKE_CHAR((unsigned char) OBJ_LINE)); scm_c_define("OBJ_BOX", SCM_MAKE_CHAR((unsigned char) OBJ_BOX)); scm_c_define("OBJ_PICTURE", SCM_MAKE_CHAR((unsigned char) OBJ_PICTURE)); scm_c_define("OBJ_CIRCLE", SCM_MAKE_CHAR((unsigned char) OBJ_CIRCLE)); scm_c_define("OBJ_NET", SCM_MAKE_CHAR((unsigned char) OBJ_NET)); scm_c_define("OBJ_BUS", SCM_MAKE_CHAR((unsigned char) OBJ_BUS)); scm_c_define("OBJ_COMPLEX", SCM_MAKE_CHAR((unsigned char) OBJ_COMPLEX)); scm_c_define("OBJ_TEXT", SCM_MAKE_CHAR((unsigned char) OBJ_TEXT)); scm_c_define("OBJ_PIN", SCM_MAKE_CHAR((unsigned char) OBJ_PIN)); scm_c_define("OBJ_ARC", SCM_MAKE_CHAR((unsigned char) OBJ_ARC)); scm_c_define("OBJ_PLACEHOLDER", SCM_MAKE_CHAR((unsigned char) OBJ_PLACEHOLDER)); scm_c_define("OBJ_PATH", SCM_MAKE_CHAR((unsigned char) OBJ_PATH)); }
/* still highly temp and doesn't work right */ SCM g_get_toplevel_attribute(SCM scm_wanted_attrib) { const GList *p_iter; PAGE *p_current; char *wanted_attrib; char *attrib_value = NULL; SCM scm_return_value; TOPLEVEL *toplevel = edascm_c_current_toplevel (); SCM_ASSERT(scm_is_string (scm_wanted_attrib), scm_wanted_attrib, SCM_ARG1, "gnetlist:get-toplevel-attribute"); wanted_attrib = scm_to_utf8_string (scm_wanted_attrib); for (p_iter = geda_list_get_glist (toplevel->pages); p_iter != NULL; p_iter = g_list_next (p_iter)) { p_current = p_iter->data; /* only look for first occurrance of the attribute on each page */ attrib_value = o_attrib_search_floating_attribs_by_name (s_page_objects (p_current), wanted_attrib, 0); /* Stop when we find the first one */ if (attrib_value != NULL) break; } free (wanted_attrib); if (attrib_value != NULL) { scm_return_value = scm_from_utf8_string (attrib_value); g_free (attrib_value); } else { scm_return_value = scm_from_utf8_string ("not found"); } return (scm_return_value); }
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 scm_tls_get_cipher_info(SCM tls_smob){ scm_assert_smob_type(tls_tag, tls_smob); BIO *bio = (BIO*)SCM_SMOB_DATA(tls_smob); SSL *ssl; BIO_get_ssl(bio, &ssl); //I'm not sure if scheme copies c strings or not, so make this static //so it stays valid regardless. static char cipher_buf[128]; SSL_CIPHER *cipher = SSL_get_current_cipher(ssl); SSL_CIPHER_description(cipher, cipher_buf, 128); return scm_from_utf8_string(cipher_buf); }
/**************************************************************** * gnc_ui_qif_account_picker_new_cb * * This handler is invoked when the user wishes to create a new * account. ****************************************************************/ void gnc_ui_qif_account_picker_new_cb(GtkButton * w, gpointer user_data) { QIFAccountPickerDialog * wind = user_data; SCM name_setter = scm_c_eval_string("qif-map-entry:set-gnc-name!"); const gchar *name; int response; gchar *fullname; GtkWidget *dlg, *entry; /* Create a dialog to get the new account name. */ dlg = gtk_message_dialog_new(GTK_WINDOW(wind->dialog), GTK_DIALOG_DESTROY_WITH_PARENT, GTK_MESSAGE_QUESTION, GTK_BUTTONS_OK_CANCEL, "%s", _("Enter a name for the account")); gtk_dialog_set_default_response(GTK_DIALOG(dlg), GTK_RESPONSE_OK); entry = gtk_entry_new(); gtk_entry_set_activates_default(GTK_ENTRY(entry), TRUE); gtk_entry_set_max_length(GTK_ENTRY(entry), 250); gtk_widget_show(entry); gtk_container_add(GTK_CONTAINER(GTK_DIALOG(dlg)->vbox), entry); /* Run the dialog to get the new account name. */ response = gtk_dialog_run(GTK_DIALOG(dlg)); name = gtk_entry_get_text(GTK_ENTRY(entry)); /* Did the user enter a name and click OK? */ if (response == GTK_RESPONSE_OK && name && *name) { /* If an account is selected, this will be a new subaccount. */ if (wind->selected_name && *(wind->selected_name)) /* We have the short name; determine the full name. */ fullname = g_strjoin(gnc_get_account_separator_string(), wind->selected_name, name, (char *)NULL); else fullname = g_strdup(name); /* Save the full name and update the map entry. */ g_free(wind->selected_name); wind->selected_name = fullname; scm_call_2(name_setter, wind->map_entry, scm_from_utf8_string(fullname)); } gtk_widget_destroy(dlg); /* Refresh the tree display and give it the focus. */ build_acct_tree(wind, wind->qif_wind); gtk_widget_grab_focus(GTK_WIDGET(wind->treeview)); }
SCM gnc_kvp_value_ptr_to_scm(KvpValue* val) { if (val == nullptr) return SCM_BOOL_F; switch (val->get_type()) { case KvpValue::Type::INT64: return scm_from_int64(val->get<int64_t>()); break; case KvpValue::Type::DOUBLE: return scm_from_double (val->get<double>()); break; case KvpValue::Type::NUMERIC: return gnc_numeric_to_scm(val->get<gnc_numeric>()); break; case KvpValue::Type::STRING: { auto string = val->get<const char*>(); return string ? scm_from_utf8_string(string) : SCM_BOOL_F; break; } case KvpValue::Type::GUID: { auto tempguid = val->get<GncGUID*>(); return gnc_guid2scm(*tempguid); } break; case KvpValue::Type::TIMESPEC: return gnc_timespec2timepair(val->get<Timespec>()); break; case KvpValue::Type::FRAME: { auto frame = val->get<KvpFrame*>(); if (frame != nullptr) return SWIG_NewPointerObj(frame, SWIG_TypeQuery("_p_KvpFrame"), 0); } break; case KvpValue::Type::GDATE: return gnc_timespec2timepair(gdate_to_timespec(val->get<GDate>())); /* FIXME: handle types below */ case KvpValue::Type::GLIST: default: break; } return SCM_BOOL_F; }
SCM g_get_renamed_nets(SCM scm_level) { SCM pairlist = SCM_EOL; SCM outerlist = SCM_EOL; SET * temp_set; RENAME * temp_rename; char *level; level = scm_to_utf8_string (scm_level); for (temp_set = first_set; temp_set; temp_set = temp_set->next_set) { for (temp_rename = temp_set->first_rename; temp_rename; temp_rename = temp_rename->next) { pairlist = scm_list_n (scm_from_utf8_string (temp_rename->src), scm_from_utf8_string (temp_rename->dest), SCM_UNDEFINED); outerlist = scm_cons (pairlist, outerlist); } } free (level); return (outerlist); }
/********************************************************************\ * gnc_trans_scm_set_notes * * set the notes of a scheme transaction. * * * * Args: trans_scm - the scheme transaction * * notes - the notes to set * * Returns: Nothing * \********************************************************************/ void gnc_trans_scm_set_notes(SCM trans_scm, const char *notes) { SCM arg; initialize_scm_functions(); if (!gnc_is_trans_scm(trans_scm)) return; if (notes == NULL) return; arg = scm_from_utf8_string(notes); scm_call_2(setters.trans_scm_notes, trans_scm, arg); }
/********************************************************************\ * gnc_trans_scm_set_description * * set the description of a scheme transaction. * * * * Args: trans_scm - the scheme transaction * * description - the description to set * * Returns: Nothing * \********************************************************************/ void gnc_trans_scm_set_description(SCM trans_scm, const char *description) { SCM arg; initialize_scm_functions(); if (!gnc_is_trans_scm(trans_scm)) return; if (description == NULL) return; arg = scm_from_utf8_string(description); scm_call_2(setters.trans_scm_description, trans_scm, arg); }
/********************************************************************\ * gnc_split_scm_set_action * * set the action of a scheme representation of a split. * * * * Args: split_scm - the scheme split * * action - the action to set * * Returns: Nothing * \********************************************************************/ void gnc_split_scm_set_action(SCM split_scm, const char *action) { SCM arg; initialize_scm_functions(); if (!gnc_is_split_scm(split_scm)) return; if (action == NULL) return; arg = scm_from_utf8_string(action); scm_call_2(setters.split_scm_action, split_scm, arg); }