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);
}
