/*! \brief Evaluate a gschem action by name.
* \par Function Description
* Evaluates the action named \a action_name, which should be a UTF-8
* string naming a symbol in the user module. If evaluating the
* action fails, prints a message to the log and returns FALSE;
* otherwise, returns TRUE.
*
* \param w_current Current gschem toplevel structure.
* \param action_name Name of action to evaluate.
*
* \return TRUE on success, FALSE on failure.
*/
gboolean
g_action_eval_by_name (GschemToplevel *w_current, const gchar *action_name)
{
SCM s_eval_action_proc;
SCM s_expr;
SCM s_result;
gboolean result;
g_assert (w_current);
g_assert (action_name);
scm_dynwind_begin (0);
g_dynwind_window (w_current);
/* Get the eval-action procedure */
s_eval_action_proc =
scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("gschem action"),
"eval-action!"));
/* Build expression to evaluate */
/* FIXME use SCM_SYMBOL for quote */
s_expr = scm_list_2 (s_eval_action_proc,
scm_list_2 (scm_from_utf8_symbol ("quote"),
scm_from_utf8_symbol (action_name)));
/* Evaluate and get return value */
s_result = g_scm_eval_protected (s_expr, SCM_UNDEFINED);
result = scm_is_true (s_result);
scm_dynwind_end ();
return result;
}
/*! \brief Get the action position.
* \par Function Description
* Retrieves the current action position and stores it in \a x and \a
* y, optionally snapping it to the grid if \a snap is true. This
* should be interpreted as the position that the user was pointing
* with the mouse pointer when the current action was invoked. If
* there is no valid world position for the current action, returns
* FALSE without modifying the output variables.
*
* This should be used by actions implemented in C to figure out where
* on the schematic the user wants them to apply the action.
*
* See also the (gschem action) Scheme module.
*
* \param w_current Current gschem toplevel structure.
* \param x Location to store x coordinate.
* \param y Location to store y coordinate.
*
* \return TRUE if current action position is set, FALSE otherwise.
*/
gboolean
g_action_get_position (gboolean snap, int *x, int *y)
{
SCM s_action_position_proc;
SCM s_point;
GschemToplevel *w_current = g_current_window ();
g_assert (w_current);
/* Get the action-position procedure */
s_action_position_proc =
scm_variable_ref (scm_c_module_lookup (scm_c_resolve_module ("gschem action"),
"action-position"));
/* Retrieve the action position */
s_point = scm_call_0 (s_action_position_proc);
if (scm_is_false (s_point)) return FALSE;
if (x) {
*x = scm_to_int (scm_car (s_point));
if (snap) {
*x = snap_grid (w_current, *x);
}
}
if (y) {
*y = scm_to_int (scm_cdr (s_point));
if (snap) {
*y = snap_grid (w_current, *y);
}
}
return TRUE;
}
SCM
gnc_scm_lookup(const char *module, const char *symbol)
{
SCM scm_module = scm_c_resolve_module(module);
SCM value = scm_c_module_lookup(scm_module, symbol);
return value;
}
/* Start the LazyCat main procedure. */
static void
inner_main (void* closure, int argc, char** argv)
{
SCM main;
SCM args;
SCM module;
scm_c_define_module ("lazycat prctl", init_prctl_module, NULL);
module = scm_c_resolve_module ("lazycat daemon lazycatd");
scm_set_current_module (module);
scm_c_define_gsubr ("c-set-lazycat-signals", 0, 0, 0, set_lazycat_signals);
scm_c_export ("c-set-lazycat-signals", NULL);
main = scm_c_module_lookup (module, "main");
args = scm_program_arguments ();
scm_call_1 (scm_variable_ref (main), args);
}
SWIGINTERN SCM
SWIG_Guile_Init ()
{
static SCM swig_module;
if (swig_initialized) return swig_module;
swig_initialized = 1;
swig_module = scm_c_resolve_module("Swig swigrun");
if (ensure_smob_tag(swig_module, &swig_tag,
"swig-pointer", "swig-pointer-tag")) {
scm_set_smob_print(swig_tag, print_swig);
scm_set_smob_equalp(swig_tag, equalp_swig);
}
if (ensure_smob_tag(swig_module, &swig_collectable_tag,
"collectable-swig-pointer", "collectable-swig-pointer-tag")) {
scm_set_smob_print(swig_collectable_tag, print_collectable_swig);
scm_set_smob_equalp(swig_collectable_tag, equalp_swig);
scm_set_smob_free(swig_collectable_tag, free_swig);
}
if (ensure_smob_tag(swig_module, &swig_destroyed_tag,
"destroyed-swig-pointer", "destroyed-swig-pointer-tag")) {
scm_set_smob_print(swig_destroyed_tag, print_destroyed_swig);
scm_set_smob_equalp(swig_destroyed_tag, equalp_swig);
}
if (ensure_smob_tag(swig_module, &swig_member_function_tag,
"swig-member-function-pointer", "swig-member-function-pointer-tag")) {
scm_set_smob_print(swig_member_function_tag, print_member_function_swig);
scm_set_smob_free(swig_member_function_tag, free_swig_member_function);
}
swig_make_func = scm_permanent_object(
scm_variable_ref(scm_c_module_lookup(scm_c_resolve_module("oop goops"), "make")));
swig_keyword = scm_permanent_object(scm_from_locale_keyword((char*) "init-smob"));
swig_symbol = scm_permanent_object(scm_from_locale_symbol("swig-smob"));
#ifdef SWIG_INIT_RUNTIME_MODULE
SWIG_INIT_RUNTIME_MODULE
#endif
return swig_module;
}
SCM
gnc_scm_lookup(const char *module, const char *symbol)
{
#if defined(SCM_GUILE_MAJOR_VERSION) && \
(SCM_GUILE_MAJOR_VERSION > 0) && (SCM_GUILE_MINOR_VERSION > 4)
SCM scm_module = scm_c_resolve_module(module);
SCM value = scm_c_module_lookup(scm_module, symbol);
return value;
#else
gchar *in_guard_str;
gchar *thunk_str;
SCM in_guard;
SCM thunk;
SCM out_guard;
SCM result;
in_guard_str =
g_strdup_printf("(lambda () (set-current-module (resolve-module (%s))))",
module);
thunk_str = g_strdup_printf("(lambda () (eval '%s))", symbol);
in_guard = scm_c_eval_string(in_guard_str);
thunk = scm_c_eval_string(thunk_str);
out_guard = scm_c_eval_string("(let ((cm (current-module)))"
" (lambda () (set-current-module cm)))");
result = scm_dynamic_wind(in_guard, thunk, out_guard);
g_free(in_guard_str);
g_free(thunk_str);
return result;
#endif
}
/* in the form: (1 2 3 4). Repeated slots are NOT returned */
SCM g_get_unique_slots(SCM scm_uref)
{
NETLIST *nl_current;
char *uref;
gchar *slot = NULL;
char *slot_tmp = NULL;
SCM slots_list = SCM_EOL;
SCM slot_number;
SCM_ASSERT(scm_is_string (scm_uref),
scm_uref, SCM_ARG1, "gnetlist:get-unique-slots-used-of-package");
uref = SCM_STRING_CHARS (scm_uref);
/* here is where you make it multi page aware */
nl_current = netlist_head;
/* search for the first instance */
/* through the entire list */
while (nl_current != NULL) {
if (nl_current->component_uref) {
if (strcmp(nl_current->component_uref, uref) == 0) {
/* first search outside the symbol */
slot_tmp =
o_attrib_search_name_single(nl_current->object_ptr,
"slot", NULL);
if (!slot_tmp) {
/* if not found, search inside the symbol */
slot_tmp =
o_attrib_search_name(nl_current->object_ptr->
complex->prim_objs, "slot",
0);
}
/* When a package has no slot attribute, then assume it's slot number 1 */
if (!slot_tmp) {
slot_tmp=g_strdup("1");
}
slot = g_strconcat ("#d", slot_tmp, NULL);
slot_number = scm_string_to_number(scm_makfrom0str (slot),
scm_from_int(10));
g_free (slot);
if (slot_number != SCM_BOOL_F) {
if (scm_member(slot_number, slots_list) == SCM_BOOL_F) {
slots_list = scm_cons (slot_number, slots_list);
}
}
else
fprintf(stderr, "Uref %s: Bad slot number: %s.\n", uref, slot_tmp);
g_free (slot_tmp);
}
}
nl_current = nl_current->next;
}
slots_list = scm_sort_list_x(slots_list,
SCM_VARIABLE_REF (scm_c_module_lookup (
scm_current_module (), "<")));
return (slots_list);
}
