/*! \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 Evaluate a string as a Scheme expression safely
* \par Function Description
*
* Evaluates a string similarly to scm_eval_string(), but catching
* any errors or exceptions and reporting them via the libgeda
* logging mechanism.
*
* See also g_scm_eval_protected() and g_scm_c_eval_string_protected().
*
* \param str String to evaluate.
*
* \returns Evaluation results or SCM_BOOL_F if exception caught.
*/
SCM g_scm_eval_string_protected (SCM str)
{
SCM expr = scm_list_2 (scm_from_utf8_symbol ("eval-string"),
str);
return g_scm_eval_protected (expr, SCM_UNDEFINED);
}
/*! \brief Gets a Scheme hook object by name.
* \par Function Description
* Returns the contents of variable with the given name in the (gschem
* core hook). Used for looking up hook objects.
*
* \param name name of hook to lookup.
* \return value found in the (gschem core hook) module.
*/
static SCM
g_get_hook_by_name (const char *name)
{
SCM exp = scm_list_3 (at_sym,
scm_list_3 (gschem_sym, core_sym, hook_sym),
scm_from_utf8_symbol (name));
return g_scm_eval_protected (exp, SCM_UNDEFINED);
}
SCM g_scm_c_get_uref (TOPLEVEL *toplevel, OBJECT *object)
{
SCM func = scm_variable_ref (scm_c_lookup ("get-uref"));
SCM object_smob = g_make_object_smob (toplevel, object);
SCM exp = scm_list_2 (func, object_smob);
return g_scm_eval_protected (exp, SCM_UNDEFINED);
}
SCM g_scm_c_get_uref (OBJECT *object)
{
SCM func = scm_variable_ref (scm_c_lookup ("get-uref"));
SCM object_smob = edascm_from_object (object);
SCM exp = scm_list_2 (func, object_smob);
return g_scm_eval_protected (exp, SCM_UNDEFINED);
}
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);
}
/*! \brief Runs a object hook with a single OBJECT.
* \par Function Description
* Runs a hook called \a name, which should expect a list of #OBJECT
* smobs as its argument, with a single-element list containing only \a obj.
*
* \see g_run_hook_object_list()
*
* \param name name of hook to run.
* \param obj #OBJECT argument for hook.
*/
void
g_run_hook_object (GschemToplevel *w_current, const char *name, OBJECT *obj)
{
scm_dynwind_begin (0);
g_dynwind_window (w_current);
SCM expr = scm_list_3 (run_hook_sym,
g_get_hook_by_name (name),
scm_list_2 (list_sym, edascm_from_object (obj)));
g_scm_eval_protected (expr, scm_interaction_environment ());
scm_dynwind_end ();
scm_remember_upto_here_1 (expr);
}
static void
x_window_invoke_macro (GschemMacroWidget *widget, int response, GschemToplevel *w_current)
{
if (response == GTK_RESPONSE_OK) {
const char *macro = gschem_macro_widget_get_macro_string (widget);
SCM interpreter = scm_list_2(scm_from_utf8_symbol("invoke-macro"),
scm_from_utf8_string(macro));
scm_dynwind_begin (0);
g_dynwind_window (w_current);
g_scm_eval_protected(interpreter, SCM_UNDEFINED);
scm_dynwind_end ();
}
gtk_widget_grab_focus (w_current->drawing_area);
gtk_widget_hide (GTK_WIDGET (widget));
}
/*! \brief Runs a object hook for a list of objects.
* \par Function Description
* Runs a hook called \a name, which should expect a list of #OBJECT
* smobs as its argument, with \a obj_lst as the argument list.
*
* \see g_run_hook_object()
*
* \param name name of hook to run.
* \param obj_lst list of #OBJECT smobs as hook argument.
*/
void
g_run_hook_object_list (GschemToplevel *w_current, const char *name,
GList *obj_lst)
{
SCM lst = SCM_EOL;
GList *iter;
scm_dynwind_begin (0);
g_dynwind_window (w_current);
for (iter = obj_lst; iter != NULL; iter = g_list_next (iter)) {
lst = scm_cons (edascm_from_object ((OBJECT *) iter->data), lst);
}
SCM expr = scm_list_3 (run_hook_sym,
g_get_hook_by_name (name),
scm_cons (list_sym,
scm_reverse_x (lst, SCM_EOL)));
g_scm_eval_protected (expr, scm_interaction_environment ());
scm_dynwind_end ();
scm_remember_upto_here_1 (expr);
}
/*! \brief Main Scheme(GUILE) program function.
* \par Function Description
* This function is the main program called from scm_boot_guile.
* It handles initializing all libraries and gSchem variables
* and passes control to the gtk main loop.
*/
void main_prog(void *closure, int argc, char *argv[])
{
int i;
char *cwd = NULL;
GSCHEM_TOPLEVEL *w_current = NULL;
char *input_str = NULL;
int argv_index;
int first_page = 1;
char *filename;
SCM scm_tmp;
#ifdef HAVE_GTHREAD
/* Gschem isn't threaded, but some of GTK's file chooser
* backends uses threading so we need to call g_thread_init().
* GLib requires threading be initialised before any other GLib
* functions are called. Do it now if its not already setup. */
if (!g_thread_supported ()) g_thread_init (NULL);
#endif
#if ENABLE_NLS
/* this should be equivalent to setlocale (LC_ALL, "") */
gtk_set_locale();
/* This must be the same for all locales */
setlocale(LC_NUMERIC, "C");
/* Disable gtk's ability to set the locale. */
/* If gtk is allowed to set the locale, then it will override the */
/* setlocale for LC_NUMERIC (which is important for proper PS output. */
/* This may look funny here, given we make a call to gtk_set_locale() */
/* above. I don't know yet, if this is really the right thing to do. */
gtk_disable_setlocale();
#endif
gtk_init(&argc, &argv);
argv_index = parse_commandline(argc, argv);
cwd = g_get_current_dir();
libgeda_init();
/* create log file right away even if logging is enabled */
s_log_init ("gschem");
s_log_message(
_("gEDA/gschem version %s%s.%s\n"), PREPEND_VERSION_STRING,
PACKAGE_DOTTED_VERSION, PACKAGE_DATE_VERSION);
s_log_message(
_("gEDA/gschem comes with ABSOLUTELY NO WARRANTY; see COPYING for more details.\n"));
s_log_message(
_("This is free software, and you are welcome to redistribute it under certain\n"));
s_log_message(
_("conditions; please see the COPYING file for more details.\n\n"));
#if defined(__MINGW32__) && defined(DEBUG)
fprintf(stderr, _("This is the MINGW32 port.\n"));
#endif
#if DEBUG
fprintf(stderr, _("Current locale settings: %s\n"), setlocale(LC_ALL, NULL));
#endif
/* init global buffers */
o_buffer_init();
/* register guile (scheme) functions */
g_register_funcs();
g_init_window ();
g_init_select ();
g_init_hook ();
g_init_attrib ();
g_init_keys ();
g_init_util ();
/* initialise color map (need to do this before reading rc files */
x_color_init ();
o_undo_init();
if (s_path_sys_data () == NULL) {
const gchar *message =
_("You must set the GEDADATA environment variable!\n\n"
"gschem cannot locate its data files. You must set the GEDADATA\n"
"environment variable to point to the correct location.\n");
GtkWidget* error_diag =
gtk_message_dialog_new (NULL, 0, GTK_MESSAGE_ERROR,
GTK_BUTTONS_OK,
"%s", message);
gtk_dialog_run (GTK_DIALOG (error_diag));
g_error ("%s", message);
}
/* Allocate w_current */
w_current = gschem_toplevel_new ();
/* Connect hooks that run for each s_toplevel_new() first */
s_toplevel_append_new_hook ((NewToplevelFunc) add_libgeda_toplevel_hooks,
w_current);
w_current->toplevel = s_toplevel_new ();
w_current->toplevel->load_newer_backup_func = x_fileselect_load_backup;
w_current->toplevel->load_newer_backup_data = w_current;
o_text_set_rendered_bounds_func (w_current->toplevel,
o_text_get_rendered_bounds, w_current);
/* Damage notifications should invalidate the object on screen */
o_add_change_notify (w_current->toplevel,
(ChangeNotifyFunc) o_invalidate,
(ChangeNotifyFunc) o_invalidate, w_current);
scm_dynwind_begin (0);
g_dynwind_window (w_current);
/* Run pre-load Scheme expressions */
g_scm_eval_protected (s_pre_load_expr, scm_current_module ());
/* By this point, libgeda should have setup the Guile load path, so
* we can take advantage of that. */
scm_tmp = scm_sys_search_load_path (scm_from_utf8_string ("gschem.scm"));
if (scm_is_false (scm_tmp)) {
s_log_message (_("Couldn't find init scm file [%s]\n"), "gschem.scm");
}
input_str = scm_to_utf8_string (scm_tmp);
if (g_read_file(w_current->toplevel, input_str, NULL)) {
s_log_message(_("Read init scm file [%s]\n"), input_str);
} else {
/*! \todo These two messages are the same. Should be
* integrated. */
s_log_message(_("Failed to read init scm file [%s]\n"),
input_str);
}
free (input_str); /* M'allocated by scm_to_utf8_string() */
scm_remember_upto_here_1 (scm_tmp);
/* Now read in RC files. */
g_rc_parse_gtkrc();
x_rc_parse_gschem (w_current, rc_filename);
/* Set default icon */
x_window_set_default_icon();
/* At end, complete set up of window. */
x_color_allocate();
x_window_setup (w_current);
#ifdef HAVE_LIBSTROKE
x_stroke_init ();
#endif /* HAVE_LIBSTROKE */
for (i = argv_index; i < argc; i++) {
if (g_path_is_absolute(argv[i]))
{
/* Path is already absolute so no need to do any concat of cwd */
filename = g_strdup (argv[i]);
} else {
filename = g_build_filename (cwd, argv[i], NULL);
}
if ( first_page )
first_page = 0;
/*
* SDB notes: at this point the filename might be unnormalized, like
* /path/to/foo/../bar/baz.sch. Bad filenames will be normalized in
* f_open (called by x_window_open_page). This works for Linux and MINGW32.
*/
x_window_open_page(w_current, filename);
g_free (filename);
}
g_free(cwd);
/* If no page has been loaded (wasn't specified in the command line.) */
/* Then create an untitled page */
if ( first_page ) {
x_window_open_page( w_current, NULL );
}
/* Update the window to show the current page */
x_window_set_current_page( w_current, w_current->toplevel->page_current );
#if DEBUG
scm_c_eval_string ("(display \"hello guile\n\")");
#endif
/* Run post-load expressions */
g_scm_eval_protected (s_post_load_expr, scm_current_module ());
/* open up log window on startup */
if (w_current->log_window == MAP_ON_STARTUP) {
x_log_open ();
}
/* if there were any symbols which had major changes, put up an error */
/* dialog box */
major_changed_dialog(w_current);
scm_dynwind_end ();
/* enter main loop */
gtk_main();
}
