static void test_scm_call () { SCM result; result = scm_call (scm_c_public_ref ("guile", "+"), scm_from_int (1), scm_from_int (2), SCM_UNDEFINED); assert (scm_is_true (scm_equal_p (result, scm_from_int (3)))); result = scm_call (scm_c_public_ref ("guile", "list"), SCM_UNDEFINED); assert (scm_is_eq (result, SCM_EOL)); }
static void test_scm_to_pointer () { int (*add3) (int a, int b, int c); SCM int_type = scm_c_public_ref ("system foreign", "int"); add3 = scm_to_pointer (scm_procedure_to_pointer (int_type, scm_c_public_ref ("guile", "+"), scm_list_3 (int_type, int_type, int_type))); assert ((*add3) (1000000, 1000, -1) == 1000999); }
VISIBLE SCM scm_raise_gsl_error (SCM arguments) { return scm_apply_0 (scm_c_public_ref ("sortsmill math gsl", "raise-gsl-error"), arguments); }
VISIBLE SCM scm_gsl_errno_to_symbol (SCM errval) { return scm_call_1 (scm_c_public_ref ("sortsmill math gsl", "gsl-errno->symbol"), errval); }
void gdbscm_enter_repl (void) { /* It's unfortunate to have to resort to something like this, but scm_shell doesn't return. :-( I found this code on guile-user@. */ gdbscm_safe_call_1 (scm_c_public_ref ("system repl repl", "start-repl"), scm_from_latin1_symbol ("scheme"), NULL); }
/*! \brief Load a subpage * * \par Function Description * Implements s_hierarchy_down_schematic(), but without changing variables * related to the UI. * * - Ensures a duplicate page is not loaded * - Does not change the current page * - Does not modify the most recent "up" page * * \param [in] page * \param [in] filename * \param [out] error * \return A pointer to the subpage or NULL if an error occured. */ PAGE* s_hierarchy_load_subpage (PAGE *page, const char *filename, GError **error) { char *string; PAGE *subpage = NULL; g_return_val_if_fail (filename != NULL, NULL); g_return_val_if_fail (page != NULL, NULL); SCM string_s = scm_call_1 (scm_c_public_ref ("geda library", "get-source-library-file"), scm_from_utf8_string (filename)); if (scm_is_false (string_s)) { g_set_error (error, EDA_ERROR, EDA_ERROR_NOLIB, _("Schematic not found in source library.")); } else { string = scm_to_utf8_string (string_s); gchar *normalized = f_normalize_filename (string, error); subpage = s_page_search (page->toplevel, normalized); if (subpage == NULL) { int success; subpage = s_page_new (page->toplevel, string); success = f_open (page->toplevel, subpage, s_page_get_filename (subpage), error); if (success) { subpage->page_control = ++page_control_counter; } else { s_page_delete (page->toplevel, subpage); subpage = NULL; } } g_free (normalized); } return subpage; }
/*! * \brief Search for schematic associated source files and load them. * \par Function Description * This function searches the associated source file refered by the * <B>filename</B> and loads it. If the <B>flag</B> is set to * <B>HIERARCHY_NORMAL_LOAD</B> and the page is already in the list of * pages it will return the <B>pid</B> of that page. * If the <B>flag</B> is set to <B>HIERARCHY_FORCE_LOAD</B> then this * function will load the page again with a new page id. The second case * is mainly used by gnetlist where pushed down schematics MUST be unique. * * \param [in] toplevel The TOPLEVEL object. * \param [in] filename Schematic file name. * \param [in] parent The parent page of the schematic. * \param [in] page_control * \param [in] flag sets whether to force load * \param [out] err Location to return a GError on failure. * \return The page loaded, or NULL if failed. * * \note * This function finds the associated source files and * loads all up * It only works for schematic files though * this is basically push * flag can either be HIERARCHY_NORMAL_LOAD or HIERARCHY_FORCE_LOAD * flag is mainly used by gnetlist where pushed down schematics MUST be unique */ PAGE * s_hierarchy_down_schematic_single(TOPLEVEL *toplevel, const gchar *filename, PAGE *parent, int page_control, int flag, GError **err) { gchar *string; PAGE *found = NULL; PAGE *forbear; g_return_val_if_fail ((toplevel != NULL), NULL); g_return_val_if_fail ((filename != NULL), NULL); g_return_val_if_fail ((parent != NULL), NULL); SCM string_s = scm_call_1 (scm_c_public_ref ("geda library", "get-source-library-file"), scm_from_utf8_string (filename)); if (scm_is_false (string_s)) { g_set_error (err, EDA_ERROR, EDA_ERROR_NOLIB, _("Schematic not found in source library.")); return NULL; } string = scm_to_utf8_string (string_s); switch (flag) { case HIERARCHY_NORMAL_LOAD: { gchar *filename = f_normalize_filename (string, NULL); found = s_page_search (toplevel, filename); g_free (filename); if (found) { /* check whether this page is in the parents list */ for (forbear = parent; forbear != NULL && found->pid != forbear->pid && forbear->up >= 0; forbear = s_page_search_by_page_id (toplevel->pages, forbear->up)) ; /* void */ if (forbear != NULL && found->pid == forbear->pid) { g_set_error (err, EDA_ERROR, EDA_ERROR_LOOP, _("Hierarchy contains a circular dependency.")); return NULL; /* error signal */ } s_page_goto (toplevel, found); if (page_control != 0) { found->page_control = page_control; } found->up = parent->pid; g_free (string); return found; } found = s_page_new (toplevel, string); f_open (toplevel, found, s_page_get_filename (found), NULL); } break; case HIERARCHY_FORCE_LOAD: { found = s_page_new (toplevel, string); f_open (toplevel, found, s_page_get_filename (found), NULL); } break; default: g_return_val_if_reached (NULL); } if (page_control == 0) { page_control_counter++; found->page_control = page_control_counter; } else { found->page_control = page_control; } found->up = parent->pid; g_free (string); return found; }
VISIBLE SCM scm_postscript_to_number_list (SCM s) { return scm_call_1 (scm_c_public_ref (my_module, "postscript->number-list"), s); }
VISIBLE SCM scm_postscript_to_boolean (SCM s) { return scm_call_1 (scm_c_public_ref (my_module, "postscript->boolean"), s); }
VISIBLE SCM scm_postscript_boolean_p (SCM s) { return scm_call_1 (scm_c_public_ref (my_module, "postscript-boolean?"), s); }
VISIBLE SCM scm_to_postscript (SCM value) { return scm_call_1 (scm_c_public_ref (my_module, "scm->postscript"), value); }