Пример #1
0
/* We assume that data is actually a char**. The way we return results
 * from this function is to malloc a fresh string, and store it in
 * this pointer. It is the caller's responsibility to do something
 * smart with this freshly allocated storage. the caller can determine
 * whether there was an error by initializing the char* passed in to
 * NULL. If there is an error, the char string will not be NULL on
 * return. */
static SCM
gfec_catcher(void *data, SCM tag, SCM throw_args)
{
    SCM func;
    SCM result;
    const char *msg = NULL;

    func = scm_c_eval_string("gnc:error->string");
    if (scm_is_procedure(func))
    {
        result = scm_call_2(func, tag, throw_args);
        if (scm_is_string(result))
        {
            char * str;

            scm_dynwind_begin (0); 
            str = scm_to_locale_string (result);
            msg = g_strdup (str);
            scm_dynwind_free (str); 
            scm_dynwind_end (); 
        }
    }

    if (msg == NULL)
    {
        msg = "Error running guile function.";
    }

    *(char**)data = strdup(msg);

    return SCM_UNDEFINED;
}
Пример #2
0
/*! \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;
}
Пример #3
0
/*! \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;
}
Пример #4
0
static SCM call_callable(SCM scm_args)
{
	SCM stack = scm_make_stack(SCM_BOOL_T, SCM_EOL);
	SCM frame = scm_stack_ref(stack, scm_from_int(0));
	SCM proc = scm_frame_procedure(frame);
	PyObject *callable = scm_to_pointer(scm_assq_ref(gsubr_alist, proc));

	scm_dynwind_begin(0);

	PyObject *py_args = scm2py(scm_args);
	if (py_args == NULL)
		py2scm_exception(); /* does not return */
	scm_dynwind_py_decref(py_args);

	struct call_callable_data data = { callable, py_args };
	PyObject *py_result = (PyObject *)scm_without_guile(
		(void *(*)(void *))call_callable1, &data);
	if (py_result == NULL)
		py2scm_exception(); /* does not return */
	scm_dynwind_py_decref(py_result);

	SCM scm_result = py2scm(py_result);
	scm_dynwind_end();
	return scm_result;
}
Пример #5
0
/*! \brief
 *  \par Function Description
 *
 *  \param [in] path 
 *  \param [in] name Optional descriptive name for library directory.
 *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 */
SCM g_rc_component_library(SCM path, SCM name)
{
  gchar *string;
  char *temp;
  char *namestr = NULL;

  SCM_ASSERT (scm_is_string (path), path,
              SCM_ARG1, "component-library");

  scm_dynwind_begin (0);
  if (name != SCM_UNDEFINED) {
    SCM_ASSERT (scm_is_string (name), name,
		SCM_ARG2, "component-library");
    namestr = scm_to_utf8_string (name);
    scm_dynwind_free(namestr);
  }

  /* take care of any shell variables */
  temp = scm_to_utf8_string (path);
  string = s_expand_env_variables (temp);
  scm_dynwind_unwind_handler (g_free, string, SCM_F_WIND_EXPLICITLY);
  free (temp);

  /* invalid path? */
  if (!g_file_test (string, G_FILE_TEST_IS_DIR)) {
    fprintf(stderr,
            "Invalid path [%s] passed to component-library\n",
            string);
    scm_dynwind_end();
    return SCM_BOOL_F;
  }

  if (g_path_is_absolute (string)) {
    s_clib_add_directory (string, namestr);
  } else {
    gchar *cwd = g_get_current_dir ();
    gchar *temp;
    temp = g_build_filename (cwd, string, NULL);
    s_clib_add_directory (temp, namestr);
    g_free(temp);
    g_free(cwd);
  }

  scm_dynwind_end();
  return SCM_BOOL_T;
}
Пример #6
0
static SCM scm_nwm_log(SCM msg)
{
    scm_dynwind_begin(0);
    char *c_msg = scm_to_locale_string(msg);
    scm_dynwind_free(c_msg);
    fprintf(stderr, "%s\n", c_msg);
    scm_dynwind_end();
    return SCM_UNSPECIFIED;
}
Пример #7
0
/*! \brief Callback to handle key events in the drawing area.
 *  \par Function Description
 *
 *  GTK+ callback function (registered in x_window_setup_draw_events() ) which
 *  handles key press and release events from the GTK+ system.
 *
 * \param [in] widget     the widget that generated the event
 * \param [in] event      the event itself
 * \param      w_current  the toplevel environment
 * \returns TRUE if the event has been handled.
 */
gboolean
x_event_key (GschemPageView *page_view, GdkEventKey *event, GschemToplevel *w_current)
{
  gboolean retval = FALSE;
  int pressed;
  gboolean special = FALSE;

  g_return_val_if_fail (page_view != NULL, FALSE);

#if DEBUG
  printf("x_event_key_pressed: Pressed key %i.\n", event->keyval);
#endif

  /* update the state of the modifiers */
  w_current->ALTKEY     = (event->state & GDK_MOD1_MASK)    ? 1 : 0;
  w_current->SHIFTKEY   = (event->state & GDK_SHIFT_MASK)   ? 1 : 0;
  w_current->CONTROLKEY = (event->state & GDK_CONTROL_MASK) ? 1 : 0;

  pressed = (event->type == GDK_KEY_PRESS) ? 1 : 0;

  switch (event->keyval) {
    case GDK_Alt_L:
    case GDK_Alt_R:
      w_current->ALTKEY = pressed;
      break;

    case GDK_Shift_L:
    case GDK_Shift_R:
      w_current->SHIFTKEY = pressed;
      special = TRUE;
      break;

    case GDK_Control_L:
    case GDK_Control_R:
      w_current->CONTROLKEY = pressed;
      special = TRUE;
      break;
  }

  scm_dynwind_begin ((scm_t_dynwind_flags) 0);
  g_dynwind_window (w_current);

  /* Special case to update the object being drawn or placed after
   * scrolling when Shift or Control were pressed */
  if (special) {
    x_event_faked_motion (page_view, event);
  }

  if (pressed)
    retval = g_keys_execute (w_current, event) ? TRUE : FALSE;

  scm_dynwind_end ();

  return retval;
}
Пример #8
0
static SCM
gdbscm_open_memory (SCM rest)
{
  const SCM keywords[] = {
    mode_keyword, start_keyword, size_keyword, SCM_BOOL_F
  };
  char *mode = NULL;
  CORE_ADDR start = 0;
  CORE_ADDR end;
  int mode_arg_pos = -1, start_arg_pos = -1, size_arg_pos = -1;
  ULONGEST size;
  SCM port;
  long mode_bits;

  gdbscm_parse_function_args (FUNC_NAME, SCM_ARG1, keywords, "#sUU", rest,
			      &mode_arg_pos, &mode,
			      &start_arg_pos, &start,
			      &size_arg_pos, &size);

  scm_dynwind_begin ((scm_t_dynwind_flags) 0);

  if (mode == NULL)
    mode = xstrdup ("r");
  scm_dynwind_free (mode);

  if (size_arg_pos > 0)
    {
      /* For now be strict about start+size overflowing.  If it becomes
	 a nuisance we can relax things later.  */
      if (start + size < start)
	{
	  gdbscm_out_of_range_error (FUNC_NAME, 0,
				scm_list_2 (gdbscm_scm_from_ulongest (start),
					    gdbscm_scm_from_ulongest (size)),
				     _("start+size overflows"));
	}
      end = start + size;
    }
  else
    end = ~(CORE_ADDR) 0;

  mode_bits = ioscm_parse_mode_bits (FUNC_NAME, mode);

  port = ioscm_open_port (memory_port_desc, mode_bits);

  ioscm_init_memory_port (port, start, end);

  scm_dynwind_end ();

  /* TODO: Set the file name as "memory-start-end"?  */
  return port;
}
Пример #9
0
SCM make_ffmpeg_input(SCM scm_file_name, SCM scm_debug)
{
  SCM retval;
  struct ffmpeg_t *self;
  scm_dynwind_begin(0);
  const char *file_name = scm_to_locale_string(scm_file_name);
  scm_dynwind_free(file_name);
  self = (struct ffmpeg_t *)scm_gc_calloc(sizeof(struct ffmpeg_t), "ffmpeg");
  self->video_stream_idx = -1;
  self->audio_stream_idx = -1;
  SCM_NEWSMOB(retval, ffmpeg_tag, self);

  int err;
  err = avformat_open_input(&self->fmt_ctx, file_name, NULL, NULL);
  if (err < 0) {
    ffmpeg_destroy(retval);
    scm_misc_error("make-ffmpeg-input", "Error opening file '~a': ~a", scm_list_2(scm_file_name, get_error_text(err)));
  };

  err = avformat_find_stream_info(self->fmt_ctx, NULL);
  if (err < 0) {
    ffmpeg_destroy(retval);
    scm_misc_error("make-ffmpeg-input", "No stream information in file '~a': ~a", scm_list_2(scm_file_name, get_error_text(err)));
  };

  // TODO: only open desired streams
  // Open video stream
  self->video_stream_idx = av_find_best_stream(self->fmt_ctx, AVMEDIA_TYPE_VIDEO, -1, -1, NULL, 0);
  if (self->video_stream_idx >= 0)
    self->video_codec_ctx = open_decoder(retval, scm_file_name, video_stream(self), "video");

  // Open audio stream
  self->audio_stream_idx = av_find_best_stream(self->fmt_ctx, AVMEDIA_TYPE_AUDIO, -1, -1, NULL, 0);
  if (self->audio_stream_idx >= 0)
    self->audio_codec_ctx = open_decoder(retval, scm_file_name, audio_stream(self), "audio");

  // Print debug information
  if (scm_is_true(scm_debug)) av_dump_format(self->fmt_ctx, 0, file_name, 0);

  // Allocate input frames
  self->video_target_frame = allocate_frame(retval);
  self->audio_target_frame = allocate_frame(retval);

  // Initialise data packet
  av_init_packet(&self->pkt);
  self->pkt.data = NULL;
  self->pkt.size = 0;

  scm_dynwind_end();
  return retval;
}
Пример #10
0
/*! \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);
}
Пример #11
0
gchar *gnc_scm_to_locale_string(SCM scm_string)
{
    gchar* s;
    char * str;

    scm_dynwind_begin (0); 
    str = scm_to_locale_string(scm_string);

    /* prevent memory leaks in scm_to_locale_string() per guile manual; see 'http://www.gnu.org/software/guile/manual/html_node/Dynamic-Wind.html#Dynamic-Wind' */
    s = g_strdup(str);
    scm_dynwind_free (str); 
    scm_dynwind_end (); 
    return s;
}
Пример #12
0
SCM scm_mmr_path_fix(SCM target)
#define FUNC_NAME "path-fix"
{
  char *path = NULL;
  char *fixed = NULL; // fixed path
  char *tmp = NULL;
  int path_len = 0;
  int bi = 0;
  int pi = 0;
  SCM ret;
  
  SCM_VALIDATE_STRING(1 ,target);

  scm_dynwind_begin(0);
  
  path = scm_to_locale_string(target);
  scm_dynwind_free(path);

  if(!strstr(path ,"/.."))
    {
      // no relative path
      ret = target;
      goto end;
    }

  path_len = strlen(path);
  path_len = path_len>MAX_PATH_LEN? MAX_PATH_LEN : path_len;
  fixed = (char *)malloc(path_len+1);
  fixed[0] = '\n'; // sentinal

  while(get_dir(path ,fixed+1 ,&pi ,&bi))
    {}

  /* NOTE: The result won't contain '/' at the end,
   * because we'll append *path '/' filename* finally.
   */

  tmp = fix_prefix(fixed+1);
  ret = scm_from_locale_string(tmp);

  free(fixed);
  fixed = NULL;
  tmp = NULL;

 end:
  scm_dynwind_end();
  return ret;
}
Пример #13
0
static void
load_extension (SCM lib, SCM init)
{
  extension_t *head;

  scm_i_pthread_mutex_lock (&ext_lock);
  head = registered_extensions;
  scm_i_pthread_mutex_unlock (&ext_lock);

  /* Search the registry. */
  if (head != NULL)
    {
      extension_t *ext;
      char *clib, *cinit;
      int found = 0;

      scm_dynwind_begin (0);

      clib = scm_to_locale_string (lib);
      scm_dynwind_free (clib);
      cinit = scm_to_locale_string (init);
      scm_dynwind_free (cinit);

      for (ext = head; ext; ext = ext->next)
	if ((ext->lib == NULL || !strcmp (ext->lib, clib))
	    && !strcmp (ext->init, cinit))
	  {
	    ext->func (ext->data);
            found = 1;
	    break;
	  }

      scm_dynwind_end ();

      if (found)
        return;
    }

  /* Dynamically link the library. */
#if HAVE_MODULES
  scm_dynamic_call (init, scm_dynamic_link (lib));
#else
  scm_misc_error ("load-extension",
                  "extension ~S:~S not registered and dynamic-link disabled",
                  scm_list_2 (init, lib));
#endif
}
Пример #14
0
static SCM scm_bind_key(SCM mod_mask, SCM key, SCM proc)
{
    xcb_keysym_t keysym;
    if (scm_is_true(scm_number_p(key)))
        keysym = scm_to_uint32(key);
    else if (scm_is_true(scm_string_p(key))) {
        scm_dynwind_begin(0);
        char *c_key = scm_to_locale_string(key);
        scm_dynwind_free(c_key);
        keysym = get_keysym(c_key);
        scm_dynwind_end();
    }
    else
        return SCM_UNSPECIFIED;
    bind_key(scm_to_uint16(mod_mask), keysym, proc);
    return SCM_UNSPECIFIED;
}
Пример #15
0
/*! \brief Evaluates the stroke.
 *  \par Function Description
 *  This function transforms the stroke input so far in an action.
 *
 *  It makes use of the guile procedure <B>eval-stroke</B> to evaluate
 *  the stroke sequence into a possible action. The mouse footprint is
 *  erased in this function.
 *
 *  It returns 1 if the stroke has been successfully evaluated as an
 *  action. It returns 0 if libstroke failed to transform the stroke
 *  or there is no action attached to the stroke.
 *
 *  \param [in] w_current The GschemToplevel object.
 *  \returns 1 on success, 0 otherwise.
 */
gint
x_stroke_translate_and_execute (GschemToplevel *w_current)
{
  gchar sequence[STROKE_MAX_SEQUENCE];
  StrokePoint *point;
  int min_x, min_y, max_x, max_y;
  guint i;

  g_assert (stroke_points != NULL);

  if (stroke_points->len == 0)
    return 0;

  point = &g_array_index (stroke_points, StrokePoint, 0);
  min_x = max_x = point->x;
  min_y = max_y = point->y;

  for (i = 1; i < stroke_points->len; i++) {
    point = &g_array_index (stroke_points, StrokePoint, i);
    min_x = MIN (min_x, point->x);
    min_y = MIN (min_y, point->y);
    max_x = MAX (max_x, point->x);
    max_y = MAX (max_y, point->y);
  }

  o_invalidate_rect (w_current, min_x, min_y, max_x + 1, max_y + 1);

  /* resets length of array */
  stroke_points->len = 0;

  /* try evaluating stroke */
  if (stroke_trans ((char*)&sequence)) {
    gchar *guile_string =
      g_strdup_printf("(eval-stroke \"%s\")", sequence);
    SCM ret;

    scm_dynwind_begin ((scm_t_dynwind_flags) 0);
    scm_dynwind_unwind_handler (g_free, guile_string, SCM_F_WIND_EXPLICITLY);
    ret = g_scm_c_eval_string_protected (guile_string);
    scm_dynwind_end ();

    return (SCM_NFALSEP (ret));
  }

  return 0;
}
Пример #16
0
SCM scm_mmr_create_this_path(SCM path ,SCM mode)
#define FUNC_NAME "create-this-path"
{
  char *p = NULL;
  char *b = NULL;
  char *buf = NULL;
  SCM ret = SCM_BOOL_F;
  int m = 0777;
  int len = 0;
  int n = 0;
  
  SCM_VALIDATE_STRING(1 ,path);

  if(!SCM_UNBNDP(mode))
    {
      SCM_VALIDATE_NUMBER(2 ,mode);
      m = scm_to_int(mode);
    }

  scm_dynwind_begin(0);
  
  p = scm_to_locale_string(path);
  scm_dynwind_free(p);
  
  len = strlen(p);
  buf = (char*)malloc(len+1); // Don't forget +1 for '\0'
  n = get_path_levels(p ,len);
  
  while(n >= 0)
    {
      int l = 0;
      b = get_parent_path(p ,&n ,len);
      l = b-p;
      memcpy(buf ,b ,l);
      buf[l+1] = '\0';
      do_create(buf ,len);
    }

  free(buf);
  buf = NULL;

  scm_dynwind_end();
  
  return ret; 
}
Пример #17
0
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));
}
Пример #18
0
/*! \brief Print a representation of a #GschemToplevel smob.
 * \par Function Description
 * Outputs a string representing the \a smob to a Scheme output
 * \a port. The format used is "#<gschem-window b7ef65d0>".
 *
 * Used internally to Guile.
 */
static int
smob_print (SCM smob, SCM port, scm_print_state *pstate)
{
    gchar *hexstring;

    scm_puts ("#<gschem-window", port);

    scm_dynwind_begin (0);
    hexstring = g_strdup_printf (" %zx", SCM_SMOB_DATA (smob));
    scm_dynwind_unwind_handler (g_free, hexstring, SCM_F_WIND_EXPLICITLY);
    scm_puts (hexstring, port);
    scm_dynwind_end ();

    scm_puts (">", port);

    /* Non-zero means success */
    return 1;
}
Пример #19
0
static SCM
scm_elev_scm_spline (const char *who,
                     void elev_scm_spline (size_t new_degree,
                                           size_t degree,
                                           ssize_t stride,
                                           const SCM *spline,
                                           ssize_t result_stride,
                                           SCM *result),
                     SCM new_degree, SCM spline)
{
  scm_t_array_handle handle;
  scm_t_array_handle handle2;

  scm_dynwind_begin (0);

  const size_t _new_degree = scm_to_size_t (new_degree);

  scm_array_get_handle (spline, &handle);
  scm_dynwind_array_handle_release (&handle);
  assert_c_rank_1_or_2_array (who, spline, &handle);

  size_t dim;
  ssize_t stride;
  scm_array_handle_get_vector_dim_and_stride (who, spline, &handle,
                                              &dim, &stride);
  const SCM *_spline = scm_array_handle_elements (&handle);

  if (_new_degree < dim - 1)
    the_new_degree_is_not_an_elevation (who, new_degree,
                                        scm_from_size_t (dim - 1), spline);

  SCM result = scm_make_array (SCM_UNSPECIFIED,
                               scm_list_1 (scm_oneplus (new_degree)));
  scm_array_get_handle (result, &handle2);
  scm_dynwind_array_handle_release (&handle2);
  SCM *_result = scm_array_handle_writable_elements (&handle2);

  elev_scm_spline (_new_degree, dim - 1, stride, _spline, 1, _result);

  scm_dynwind_end ();

  return result;
}
Пример #20
0
static SCM scm_launch_program(SCM prog)
{
    scm_dynwind_begin(0);
    char *c_path = scm_to_locale_string(scm_car(prog));
    scm_dynwind_free(c_path);
    fprintf(stderr, "launching program %s\n", c_path);
    pid_t pid = fork();
    if (pid == 0) {
      if (scm_is_false(scm_execlp(scm_car(prog), prog))) {
            perror("execl failed");
            exit(2);
        }
    }
    else {
        fprintf(stderr, "launched %s as pid %d\n", c_path, pid);
    }
    scm_dynwind_end();
    return SCM_UNSPECIFIED;
}
Пример #21
0
/*! \brief Print a representation of a gEDA smob.
 * \par Function Description
 * Outputs a string representing the gEDA \a smob to a Scheme output
 * \a port. The format used is "#<geda-TYPE b7ef65d0>", where TYPE is
 * a string describing the C structure represented by the gEDA smob.
 *
 * Used internally to Guile.
 */
static int
smob_print (SCM smob, SCM port, scm_print_state *pstate)
{
  gchar *hexstring;

  scm_puts ("#<geda-", port);

  switch (EDASCM_SMOB_TYPE (smob)) {
  case GEDA_SMOB_TOPLEVEL:
    scm_puts ("toplevel", port);
    break;
  case GEDA_SMOB_PAGE:
    scm_puts ("page", port);
    break;
  case GEDA_SMOB_OBJECT:
    scm_puts ("object", port);
    break;
  case GEDA_SMOB_CONFIG:
    scm_puts ("config", port);
    break;
  case GEDA_SMOB_CLOSURE:
    scm_puts ("closure", port);
    break;
  default:
    g_critical ("%s: received bad smob flags.", __FUNCTION__);
    scm_puts ("unknown", port);
  }

  if (SCM_SMOB_DATA (smob) != 0) {
    scm_dynwind_begin (0);
    hexstring = g_strdup_printf (" %p", (void *) SCM_SMOB_DATA (smob));
    scm_dynwind_unwind_handler (g_free, hexstring, SCM_F_WIND_EXPLICITLY);
    scm_puts (hexstring, port);
    scm_dynwind_end ();
  } else {
    scm_puts (" (null)", port);
  }

  scm_puts (">", port);

  /* Non-zero means success */
  return 1;
}
Пример #22
0
/*! \brief Guile callback for adding library commands.
 *  \par Function Description
 *  Callback function for the "component-library-command" Guile
 *  function, which can be used in the rc files to add a command to
 *  the component library.
 *
 *  \param [in] listcmd command to get a list of symbols
 *  \param [in] getcmd  command to get a symbol from the library
 *  \param [in] name    Optional descriptive name for component source.
 *  \return SCM_BOOL_T on success, SCM_BOOL_F otherwise.
 */
SCM g_rc_component_library_command (SCM listcmd, SCM getcmd, 
                                    SCM name)
{
  const CLibSource *src;
  gchar *lcmdstr, *gcmdstr;
  char *tmp_str, *namestr;

  SCM_ASSERT (scm_is_string (listcmd), listcmd, SCM_ARG1, 
              "component-library-command");
  SCM_ASSERT (scm_is_string (getcmd), getcmd, SCM_ARG2, 
              "component-library-command");
  SCM_ASSERT (scm_is_string (name), name, SCM_ARG3, 
              "component-library-command");

  scm_dynwind_begin(0);

  /* take care of any shell variables */
  /*! \bug this may be a security risk! */
  tmp_str = scm_to_utf8_string (listcmd);
  lcmdstr = s_expand_env_variables (tmp_str);
  scm_dynwind_unwind_handler (g_free, lcmdstr, SCM_F_WIND_EXPLICITLY);
  free (tmp_str); /* this should stay as free (allocated from guile) */

  /* take care of any shell variables */
  /*! \bug this may be a security risk! */
  tmp_str = scm_to_utf8_string (getcmd);
  gcmdstr = s_expand_env_variables (tmp_str);
  scm_dynwind_unwind_handler (g_free, gcmdstr, SCM_F_WIND_EXPLICITLY);
  free (tmp_str); /* this should stay as free (allocated from guile) */

  namestr = scm_to_utf8_string (name);

  src = s_clib_add_command (lcmdstr, gcmdstr, namestr);

  free (namestr); /* this should stay as free (allocated from guile) */

  scm_dynwind_end();

  if (src != NULL) return SCM_BOOL_T;

  return SCM_BOOL_F;
}
Пример #23
0
SCM
scm_internal_dynamic_wind (scm_t_guard before,
			   scm_t_inner inner,
			   scm_t_guard after,
			   void *inner_data,
			   void *guard_data)
{
  SCM ans;

  scm_c_issue_deprecation_warning
    ("`scm_internal_dynamic_wind' is deprecated.  "
     "Use the `scm_dynwind_begin' / `scm_dynwind_end' API instead.");

  scm_dynwind_begin (SCM_F_DYNWIND_REWINDABLE);
  scm_dynwind_rewind_handler (before, guard_data, SCM_F_WIND_EXPLICITLY);
  scm_dynwind_unwind_handler (after, guard_data, SCM_F_WIND_EXPLICITLY);
  ans = inner (inner_data);
  scm_dynwind_end ();
  return ans;
}
Пример #24
0
SCM scm_mmr_check_file_perms(SCM target ,SCM perms)
#define FUNC_NAME "check-file-perms"
{
  int p = 0;
  char *filename = NULL;
  SCM ret = SCM_BOOL_F;
  struct stat sb;
  int mode = 0;
  int pa = 0 ,pu = 0 ,pr = 0;
    
  SCM_VALIDATE_STRING(1 ,target);
  SCM_VALIDATE_NUMBER(2 ,perms);

  scm_dynwind_begin(0);
  errno = 0;

  p = scm_to_int(perms);
  filename = scm_to_locale_string(target);
  scm_dynwind_free(filename);
  
  if(stat(filename ,&sb))
    {
      goto end;
    }

  mode = sb.st_mode;
  pa = PERMS_A & p;
  pu = PERMS_U & p;
  pr = PERMS_R & p;
  
  if((pa == (mode & pa)) ||
     (pu == (mode & pu)) ||
     (pr == (mode & pr)))
    {
      ret = SCM_BOOL_T;
    }
  
 end:
  scm_dynwind_end();
  return ret;
}
Пример #25
0
/*! \brief Verify the version of the RC file under evaluation.
 *  \par Function Description
 *
 *  Implements the Scheme function "gschem-version". Tests the version
 *  string in the argument against the version of the application
 *  itself.
 *
 *  \param [in] scm_version Scheme object containing RC file version string
 *
 *  \returns #t if the version of the RC file matches the application,
 *           else #f.
 */
SCM g_rc_gschem_version(SCM scm_version)
{
    SCM ret;
    char *version;
    SCM rc_filename;
    char *sourcefile;

    SCM_ASSERT (scm_is_string (scm_version), scm_version,
                SCM_ARG1, "gschem-version");

    scm_dynwind_begin (0);
    version = scm_to_utf8_string (scm_version);
    scm_dynwind_free (version);

    if (g_utf8_collate (g_utf8_casefold (version,-1),
                        g_utf8_casefold (PACKAGE_DATE_VERSION,-1)) != 0) {
        sourcefile = NULL;
        rc_filename = g_rc_rc_filename ();
        if (rc_filename == SCM_BOOL_F) {
            rc_filename = scm_from_utf8_string ("unknown");
        }
        sourcefile = scm_to_utf8_string (rc_filename);
        scm_dynwind_free (sourcefile);
        fprintf(stderr,
                _("You are running gEDA/gaf version [%s%s.%s],\n"),
                PREPEND_VERSION_STRING, PACKAGE_DOTTED_VERSION,
                PACKAGE_DATE_VERSION);
        fprintf(stderr,
                _("but you have a version [%s] gschemrc file:\n[%s]\n"),
                version, sourcefile);
        fprintf(stderr,
                _("Please be sure that you have the latest rc file.\n"));
        ret = SCM_BOOL_F;
    } else {
        ret = SCM_BOOL_T;
    }
    scm_dynwind_end();
    return ret;
}
Пример #26
0
static SCM g_get_duplicogram(void)
{
    SCM lst = SCM_EOL;
    uint64_t const nb_pkts = nb_nodups + nb_dups;

    scm_dynwind_begin(0);
    mutex_lock(&dup_lock);
    scm_dynwind_unwind_handler(pthread_mutex_unlock_, &dup_lock.mutex, SCM_F_WIND_EXPLICITLY);

    unsigned dt = bucket_width/2;
    for (unsigned x = 0; x < nb_buckets; x++, dt += bucket_width) {
        lst = scm_cons(
                scm_cons(scm_from_uint(dt),
                         scm_from_double(nb_pkts > 0 ? (double)dups[x] / nb_pkts : 0.)),
                lst);
    }

    dup_reset_locked();
    scm_dynwind_end();

    return lst;
}
Пример #27
0
/*! \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);
}
Пример #28
0
/************************************************************
 *               Style Sheet Selection Dialog               *
 ************************************************************/
static void
gnc_style_sheet_select_dialog_add_one(StyleSheetDialog * ss,
                                      SCM sheet_info,
                                      gboolean select)
{
    SCM get_name, scm_name;
    const gchar *c_name;
    char * str;
    GtkTreeSelection *selection;
    GtkTreeIter iter;

    get_name = scm_c_eval_string("gnc:html-style-sheet-name");
    scm_name = scm_call_1(get_name, sheet_info);
    scm_dynwind_begin (0); 
    str = scm_to_locale_string (scm_name);
    c_name = g_strdup (str);
    scm_dynwind_free (str); 
    scm_dynwind_end (); 
    if (!c_name)
        return;

    /* add the column name */
    scm_gc_protect_object(sheet_info);
    gtk_list_store_append (ss->list_store, &iter);
    gtk_list_store_set (ss->list_store, &iter,
                        /* Translate the displayed name */
                        COLUMN_NAME, _(c_name),
                        COLUMN_STYLESHEET, sheet_info,
                        -1);
    /* The translation of the name fortunately doesn't affect the
     * lookup because that is done through the sheet_info argument. */

    if (select)
    {
        selection = gtk_tree_view_get_selection (ss->list_view);
        gtk_tree_selection_select_iter (selection, &iter);
    }
}
Пример #29
0
static int
my_main (int argc, char **argv)
{
  setlocale (LC_ALL, "");

  scm_dynwind_begin (0);

  CBLAS_SIDE_t Side = side_func (argv[1]);
  CBLAS_UPLO_t Uplo = uplo_func (argv[2]);
  CBLAS_TRANSPOSE_t TransA = trans_func (argv[3]);
  CBLAS_DIAG_t Diag = diag_func (argv[4]);

  int m = atoi (argv[5]);
  int n = atoi (argv[6]);

  mpq_t alpha;
  mpq_init (alpha);
  scm_dynwind_mpq_clear (alpha);
  mpq_set_str (alpha, argv[7], 0);
  mpq_canonicalize (alpha);

  int k = (Side == CblasLeft) ? m : n;

  mpq_t A[k][k];
  mpq_matrix_init (k, k, A);
  scm_dynwind_mpq_matrix_clear (k, k, A);

  mpq_t B[m][n];
  mpq_matrix_init (m, n, B);
  scm_dynwind_mpq_matrix_clear (m, n, B);

  double A1[k][k];
  double B1[m][n];

  gsl_matrix_view mA1 = gsl_matrix_view_array (&A1[0][0], k, k);
  gsl_matrix_view mB1 = gsl_matrix_view_array (&B1[0][0], m, n);

  unsigned int i_argv = 8;

  for (unsigned int i = 0; i < k; i++)
    for (unsigned int j = 0; j < k; j++)
      {
        mpq_set_str (A[i][j], argv[i_argv], 0);
        mpq_canonicalize (A[i][j]);
        A1[i][j] = mpq_get_d (A[i][j]);
        i_argv++;
      }

  for (unsigned int i = 0; i < m; i++)
    for (unsigned int j = 0; j < n; j++)
      {
        mpq_set_str (B[i][j], argv[i_argv], 0);
        mpq_canonicalize (B[i][j]);
        B1[i][j] = mpq_get_d (B[i][j]);
        i_argv++;
      }

  mpq_matrix_trmm (Side, Uplo, TransA, Diag, m, n, alpha, A, B);
  gsl_blas_dtrmm (Side, Uplo, TransA, Diag, mpq_get_d (alpha), &mA1.matrix,
                  &mB1.matrix);

  int exit_status = 0;

  // Check that we get the same results as gsl_blas_dtrmm.
  for (unsigned int i = 0; i < m; i++)
    for (unsigned int j = 0; j < n; j++)
      {
        gmp_printf ("B[%u][%u] = %lf\t%Qd\n", i, j, B1[i][j], B[i][j]);
        if (10000 * DBL_EPSILON < fabs (mpq_get_d (B[i][j]) - B1[i][j]))
          exit_status = 1;
      }

  scm_dynwind_end ();

  return exit_status;
}
Пример #30
0
static void
cmd_export_impl (void *data, int argc, char **argv)
{
  int i;
  GError *err = NULL;
  gchar *tmp;
  const gchar *out_suffix;
  struct ExportFormat *exporter = NULL;
  GArray *render_color_map = NULL;
  gchar *original_cwd = g_get_current_dir ();

  gtk_init_check (&argc, &argv);
  scm_init_guile ();
  libgeda_init ();
  scm_dynwind_begin (0);
  toplevel = s_toplevel_new ();
  edascm_dynwind_toplevel (toplevel);

  /* Now load rc files, if necessary */
  if (getenv ("GAF_INHIBIT_RCFILES") == NULL) {
    g_rc_parse (toplevel, "gaf export", NULL, NULL);
  }
  i_vars_libgeda_set (toplevel); /* Ugh */

  /* Parse configuration files */
  export_config ();

  /* Parse command-line arguments */
  export_command_line (argc, argv);

  /* If no format was specified, try and guess from output
   * filename. */
  if (settings.format == NULL) {
    out_suffix = strrchr (settings.outfile, '.');
    if (out_suffix != NULL) {
      out_suffix++; /* Skip '.' */
    } else {
      fprintf (stderr,
               _("ERROR: Cannot infer output format from filename '%s'.\n"),
               settings.outfile);
      exit (1);
    }
  }

  /* Try and find an exporter function */
  tmp = g_utf8_strdown ((settings.format == NULL) ? out_suffix : settings.format, -1);
  for (i = 0; formats[i].name != NULL; i++) {
    if (strcmp (tmp, formats[i].alias) == 0) {
      exporter = &formats[i];
      break;
    }
  }
  if (exporter == NULL) {
    if (settings.format == NULL) {
      fprintf (stderr,
               _("ERROR: Cannot find supported format for filename '%s'.\n"),
               settings.outfile);
      exit (1);
    } else {
      fprintf (stderr,
               _("ERROR: Unsupported output format '%s'.\n"),
               settings.format);
      fprintf (stderr, see_help_msg);
      exit (1);
    }
  }
  g_free (tmp);

  /* If more than one schematic/symbol file was specified, check that
   * exporter supports multipage output. */
  if ((settings.infilec > 1) && !(exporter->flags & OUTPUT_MULTIPAGE)) {
    fprintf (stderr,
             _("ERROR: Selected output format does not support multipage output\n"));
    exit (1);
  }

  /* Load schematic files */
  while (optind < argc) {
    PAGE *page;
    tmp = argv[optind++];

    page = s_page_new (toplevel, tmp);
    if (!f_open (toplevel, page, tmp, &err)) {
      fprintf (stderr,
               _("ERROR: Failed to load '%s': %s\n"), tmp,
               err->message);
      exit (1);
    }
    if (g_chdir (original_cwd) != 0) {
      fprintf (stderr,
               _("ERROR: Failed to change directory to '%s': %s\n"),
               original_cwd, g_strerror (errno));
      exit (1);
    }
  }

  /* Create renderer */
  renderer = eda_renderer_new (NULL, NULL);
  if (settings.font != NULL) {
    g_object_set (renderer, "font-name", settings.font, NULL);
  }

  /* Make sure libgeda knows how to calculate the bounds of text
   * taking into account font etc. */
  o_text_set_rendered_bounds_func (toplevel,
                                   export_text_rendered_bounds,
                                   renderer);

  /* Create color map */
  render_color_map =
    g_array_sized_new (FALSE, FALSE, sizeof(GedaColor), MAX_COLORS);
  render_color_map =
    g_array_append_vals (render_color_map, print_colors, MAX_COLORS);
  if (!settings.color) {
    /* Create a black and white color map.  All non-background colors
     * are black. */
    GedaColor white = {~0, ~0, ~0, ~0, TRUE};
    GedaColor black = {0, 0, 0, ~0, TRUE};
    for (i = 0; i < MAX_COLORS; i++) {
      GedaColor *c = &g_array_index (render_color_map, GedaColor, i);
      if (!c->enabled) continue;

      if (c->a == 0) {
        c->enabled = FALSE;
        continue;
      }

      if (i == OUTPUT_BACKGROUND_COLOR) {
        *c = white;
      } else {
        *c = black;
      }
    }
  }
  eda_renderer_set_color_map (renderer, render_color_map);

  /* Render */
  exporter->func ();

  scm_dynwind_end ();
  exit (0);
}