Esempio n. 1
0
static SCM
scm_gnumeric_funcall (SCM funcname, SCM arglist)
{
	int i, num_args;
	GnmValue **argvals;
	GnmValue *retval;
	SCM retsmob;
	GnmCellRef cell_ref = { 0, 0, 0, 0 };

	SCM_ASSERT (SCM_NIMP (funcname) && SCM_STRINGP (funcname), funcname, SCM_ARG1, "gnumeric-funcall");
	SCM_ASSERT (SCM_NFALSEP (scm_list_p (arglist)), arglist, SCM_ARG2, "gnumeric-funcall");

	num_args = scm_ilength (arglist);
	argvals = g_new (GnmValue *, num_args);
	for (i = 0; i < num_args; ++i) {
		argvals[i] = scm_to_value (SCM_CAR (arglist));
		arglist = SCM_CDR (arglist);
	}

	retval = function_call_with_values (eval_pos, SCM_CHARS (funcname),
					    num_args,argvals);
	retsmob = value_to_scm (retval, cell_ref);
	value_release (retval);
	return retsmob;
}
Esempio n. 2
0
/*! \brief Exports the keymap in scheme to a GLib GArray.
 *  \par Function Description
 *  This function converts the list of key sequence/action pairs
 *  returned by the scheme function \c dump-current-keymap into an
 *  array of C structures.
 *
 *  The returned value must be freed by caller.
 *
 *  \return A GArray with keymap data.
  */
GArray*
g_keys_dump_keymap (void)
{
  SCM dump_proc = scm_c_lookup ("dump-current-keymap");
  SCM scm_ret;
  GArray *ret = NULL;
  struct keyseq_action_t {
    gchar *keyseq, *action;
  };

  dump_proc = scm_variable_ref (dump_proc);
  g_return_val_if_fail (SCM_NFALSEP (scm_procedure_p (dump_proc)), NULL);

  scm_ret = scm_call_0 (dump_proc);
  g_return_val_if_fail (SCM_CONSP (scm_ret), NULL);

  ret = g_array_sized_new (FALSE,
                           FALSE,
                           sizeof (struct keyseq_action_t),
                           (guint)scm_ilength (scm_ret));
  for (; scm_ret != SCM_EOL; scm_ret = SCM_CDR (scm_ret)) {
    SCM scm_keymap_entry = SCM_CAR (scm_ret);
    struct keyseq_action_t keymap_entry;

    g_return_val_if_fail (SCM_CONSP (scm_keymap_entry) &&
                          scm_is_symbol (SCM_CAR (scm_keymap_entry)) &&
                          scm_is_string (SCM_CDR (scm_keymap_entry)), ret);
    keymap_entry.action = g_strdup (SCM_SYMBOL_CHARS (SCM_CAR (scm_keymap_entry)));
    keymap_entry.keyseq = g_strdup (SCM_STRING_CHARS (SCM_CDR (scm_keymap_entry)));
    ret = g_array_append_val (ret, keymap_entry);
  }

  return ret;
}
Esempio n. 3
0
static SCM star_parse_guile (SCM fname_scm, SCM filter_string_scm, SCM ship_item_scm)
{
  char* filter_string = NULL;
  char* fname = "-";

  if (SCM_NFALSEP(filter_string_scm))
    filter_string = scm_to_locale_string(filter_string_scm);

  if (SCM_NFALSEP(fname_scm))
    fname = scm_to_locale_string(fname_scm);
  
  ship_item_cb = ship_item_scm;

  starparse(fname, filter_string, guile_cb, guile_error_handler);
  
  if (filter_string)
    free(filter_string);

  return SCM_BOOL_F;

}
Esempio n. 4
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;
}
Esempio n. 5
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 GSCHEM_TOPLEVEL object.
 *  \returns 1 on success, 0 otherwise.
 */
gint
x_stroke_translate_and_execute (GSCHEM_TOPLEVEL *w_current)
{
  gchar sequence[STROKE_MAX_SEQUENCE];
  StrokePoint *point;
  int min_x, min_y, max_x, max_y;
  gint 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;

    ret = g_scm_c_eval_string_protected (guile_string);

    g_free (guile_string);

    return (SCM_NFALSEP (ret));
  }

  return 0;
}
Esempio n. 6
0
inline bool tmscm_is_equal (tmscm o1, tmscm o2) { return SCM_NFALSEP ( scm_equal_p(o1, o2)); }
Esempio n. 7
0
void gwave_main(void *p, int argc, char **argv)
{
	int c;
	int i;
	int nobacktrace = 0;

	/* In guile-1.5 and later, need to use scm_primitive_eval_x
	 * in order to change modules so that our C primitives
	 * registered below become globals, instead of hidden away
	 * in the guile-user module
	 */
	{
		SCM exp = scm_c_read_string("(define-module (guile))");
		scm_primitive_eval_x(exp);
	}

	init_scwm_guile();
	init_gtkmisc();
	init_gwave();
	init_cmd();
	init_wavewin();
	init_wavelist();
	init_wavepanel();
	init_event();
	init_draw();
	
	gtk_init(&argc, &argv);

	prog_name = argv[0];

	/* simple pre-processing of debugging options that we need to set up
	 * before we get into guile.   These options cannot be bundled.
	 * Most of the general user options are handled in std-args.scm  */
	for(i = 1; i < argc; i++) {
		if(strcmp(argv[i], "-n") == 0) {
			nobacktrace = 1;
		} else if (strcmp(argv[i], "-v") == 0) {
			v_flag = 1;
		} else if (strcmp(argv[i], "-x") == 0) {
			x_flag = 1;
			SCM_SETCDR(scm_gwave_debug, SCM_BOOL_T);
		}
	}

	gtk_rc_parse_string(gwave_base_gtkrc);
	gtk_rc_parse("gwave.gtkrc");
//	assert( SCM_CONSP(scm_gwave_tooltips) );

#ifdef GUILE_GTK_EXTRA_LOADPATH
	scm_c_eval_string("(set! %load-path (cons \"" GUILE_GTK_EXTRA_LOADPATH "\" %load-path))");
#endif

	/* the default for this seems to have changed between guile-1.3
	   and guile-1.3.2;  only the first clause is needed when 
	   we drop support for guile-1.3.2 */
	if (!nobacktrace) {
		scm_c_eval_string("(debug-enable 'debug)(debug-enable 'backtrace) (read-enable 'positions)");
	} /* else {
	scm_c_eval_str("(debug-disable 'debug)(read-disable 'positions)");
	}*/

	/* the compiled-in initial scheme code comes from minimal.scm,
	   built into init_scheme_string.c by the Makefile
	   Among other things, it finds and loads system and user .gwaverc
	   files.
	*/
	{ /* scope */
		extern char *init_scheme_string;
		SCM res;
		if(v_flag) {fprintf(stderr, "running init_scheme_string\n");}
		res = scwm_safe_eval_str(init_scheme_string);
		if(v_flag) {
			printf("result="); fflush(stdout);
			scm_display(res, scm_cur_outp);
			printf("\n"); fflush(stdout);
		}
                if(!SCM_NFALSEP(res)) {
                        fprintf(stderr, "gwave: aborting due to errors.\n");
                        exit(1);
                }

	} /* end scope */

	wtable = g_new0(WaveTable, 1);
	wtable->cursor[0] = g_new0(VBCursor, 1);
	wtable->cursor[1] = g_new0(VBCursor, 1);
	wtable->srange = g_new0(SelRange, 1);
	wtable->npanels = 0;
	wtable->panels = NULL;

	setup_colors(wtable);
	setup_waveform_window();

	xg_init(NULL);  /* X-server interprocess communication for Gtk+ */

	gtk_main();
	exit(0);
}
Esempio n. 8
0
/* get confinement from SCM
 * in SCM, confinement is given by one of these:
 * for spherical confinement,
 *  (define confinement '(
 *    10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
 *    1.0  ;; LJ parameter r0 in "length" (so this is dimensionless value)
 *    "sphere"
 *    10.0 ;; radius of the cavity at (0, 0, 0)
 *  ))
 * for spherical confinement with a hole,
 *  (define confinement '(
 *    10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
 *    1.0  ;; LJ parameter r0 in "length" (so this is dimensionless value)
 *    "sphere+hole"
 *    10.0 ;; radius of the cavity at (0, 0, 0)
 *    1.0  ;; radius of the hole at (0, 0, 1) direction
 *  ))
 * for cylindrical confinement,
 *  (define confinement '(
 *    10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
 *    1.0  ;; LJ parameter r0 in "length" (so this is dimensionless value)
 *    "cylinder"    ;; the cylinder center goes through (0, 0, 0) and (x, y, z).
 *    10.0          ;; radius of the cylinder
 *    1.0  0.0  0.0 ;; direction vector (x, y, z) of the cylinder
 *  ))
 * for dumbbell confinement,
 *  (define confinement '(
 *    10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
 *    1.0  ;; LJ parameter r0 in "length" (so this is dimensionless value)
 *    "dumbbell" ;; the origin is at the center of the cylinder
 *    10.0       ;; left cavity radius centered at (center1, 0, 0)
 *    10.0       ;; right cavity radius centered at (center2, 0, 0)
 *    2.0        ;; length of the cylinder
 *    1.0        ;; cylinder radius
 *  ))
 * for 2D hexagonal confinement with cylinder pipe,
 *  (define confinement '(
 *    10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
 *    1.0  ;; LJ parameter r0 in "length" (so this is dimensionless value)
 *    "hex2d"
 *    10.0    ;; cavity radius
 *    1.0     ;; cylinder radius
 *    12.0    ;; lattice spacing
 *  ))
 * for porous media (outside of the 3D hexagonal particle array)
 *  (define confinement '(
 *    10.0 ;; LJ parameter epsilon in kT (so this is dimensionless value)
 *    1.0  ;; LJ parameter r0 in "length" (so this is dimensionless value)
 *    "porous"
 *    10.0    ;; particle radius
 *    20.0    ;; lattice spacing in x (2R for touching case)
 *  ))
 * INPUT
 *  var : name of the variable.
 *        in the above example, set "confinement".
 * OUTPUT
 *  returned value : struct confinement
 *                   if NULL is returned, it failed (not defined)
 */
struct confinement *
CF_guile_get (const char *var)
{
  if (guile_check_symbol (var) == 0)
    {
      fprintf (stderr, "CF_guile_get: %s is not defined\n", var);
      return (NULL);
    }

  SCM scm_symbol
    = scm_c_lookup (var);

  SCM scm_confinement
    = scm_variable_ref (scm_symbol);

  if (!SCM_NFALSEP (scm_list_p (scm_confinement)))
    {
      fprintf (stderr, "CF_guile_get: %s is not a list\n", var);
      return (NULL);
    }


  struct confinement *cf = NULL;

  unsigned long len
    = scm_num2ulong (scm_length (scm_confinement),
		     0, "CF_guile_get");
  if (len == 0)
    {
      // no confinement
      return (cf);
    }
  else if (len < 4)
    {
      fprintf (stderr, "CF_guile_get: %s is too short\n", var);
      return (NULL);
    }

  double epsilon
    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (0)),
		   "CF_guile_get");
  double r0
    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (1)),
		   "CF_guile_get");

  // get the string
  char *str_cf = NULL;
  SCM scm_conf = scm_list_ref (scm_confinement, scm_int2num (2));
#ifdef GUILE16
  size_t str_len;
  if (gh_string_p (scm_conf))
    {
      str_cf = gh_scm2newstr (scm_conf, &str_len);
    }
#else // !GUILE16
  if (scm_is_string (scm_conf))
    {
      str_cf = scm_to_locale_string (scm_conf);
    }
#endif // GUILE16
  if (strcmp (str_cf, "sphere") == 0)
    {
      if (len != 4)
	{
	  fprintf (stderr, "CF_guile_get:"
		   " for sphere, number of parameter must be 1\n");
	}
      else
	{
	  double R
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
			   "CF_guile_get");
	  cf = CF_init (0, // sphere
			R,
			0.0, // r
			0.0, 0.0, 0.0, // x, y, z
			0.0, // R2
			0.0, // L
			0, // flag_LJ
			epsilon,
			r0);
	  CHECK_MALLOC (cf, "CF_guile_get");
	}
    }
  else if (strcmp (str_cf, "sphere+hole") == 0)
    {
      if (len != 5)
	{
	  fprintf (stderr, "CF_guile_get:"
		   " for sphere+hole, number of parameter must be 2\n");
	}
      else
	{
	  double R
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
			   "CF_guile_get");
	  double r
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
			   "CF_guile_get");
	  cf = CF_init (1, // sphere+hole
			R,
			r,
			0.0, 0.0, 0.0, // x, y, z
			0.0, // R2
			0.0, // L
			0, // flag_LJ
			epsilon,
			r0);
	  CHECK_MALLOC (cf, "CF_guile_get");
	}
    }
  else if (strcmp (str_cf, "cylinder") == 0)
    {
      if (len != 7)
	{
	  fprintf (stderr, "CF_guile_get:"
		   " for cylinder, number of parameter must be 4\n");
	}
      else
	{
	  double r
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
			   "CF_guile_get");
	  double x
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
			   "CF_guile_get");
	  double y
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
			   "CF_guile_get");
	  double z
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (6)),
			   "CF_guile_get");
	  cf = CF_init (2, // cylinder
			0.0, // R,
			r,
			x, y, z,
			0.0, // R2
			0.0, // L
			0, // flag_LJ
			epsilon,
			r0);
	  CHECK_MALLOC (cf, "CF_guile_get");
	}
    }
  else if (strcmp (str_cf, "dumbbell") == 0)
    {
      if (len != 7)
	{
	  fprintf (stderr, "CF_guile_get:"
		   " for dumbbell, number of parameter must be 4\n");
	}
      else
	{
	  double R
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
			   "CF_guile_get");
	  double R2
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
			   "CF_guile_get");
	  double L
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
			   "CF_guile_get");
	  double r
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (6)),
			   "CF_guile_get");
	  cf = CF_init (3, // dumbbell
			R,
			r,
			0.0, 0.0, 0.0, // x, y, z
			R2,
			L,
			0, // flag_LJ
			epsilon,
			r0);
	  CHECK_MALLOC (cf, "CF_guile_get");
	}
    }
  else if (strcmp (str_cf, "hex2d") == 0)
    {
      if (len != 6)
	{
	  fprintf (stderr, "CF_guile_get:"
		   " for hex2d, number of parameter must be 3\n");
	}
      else
	{
	  double R
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
			   "CF_guile_get");
	  double r
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
			   "CF_guile_get");
	  double L
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (5)),
			   "CF_guile_get");
	  cf = CF_init (4, // hex2d
			R,
			r,
			0.0, 0.0, 0.0, // x, y, z
			0.0, // R2
			L,
			0, // flag_LJ
			epsilon,
			r0);
	  CHECK_MALLOC (cf, "CF_guile_get");
	}
    }
  else if (strcmp (str_cf, "porous") == 0)
    {
      if (len != 5)
	{
	  fprintf (stderr, "CF_guile_get:"
		   " for hex2d, number of parameter must be 2\n");
	}
      else
	{
	  double R
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (3)),
			   "CF_guile_get");
	  double L
	    = scm_num2dbl (scm_list_ref (scm_confinement, scm_int2num (4)),
			   "CF_guile_get");
	  cf = CF_init (5, // porous
			R,
			0.0,
			0.0, 0.0, 0.0, // x, y, z
			0.0, // R2
			L,
			0, // flag_LJ
			epsilon,
			r0);
	  CHECK_MALLOC (cf, "CF_guile_get");
	}
    }
  else
    {
      fprintf (stderr, "CF_guile_get: invalid confinement %s\n",
	       str_cf);
    }
  free (str_cf);

  return (cf); // success
}
Esempio n. 9
0
/*! \brief Add a component to the page.
 *  \par Function Description
 *  Adds a component <B>scm_comp_name</B> to the schematic, at
 *  position (<B>scm_x</B>, <B>scm_y</B>), with some properties set by
 *  the parameters:
 *  \param [in] scm_x Coordinate X of the symbol.
 *  \param [in] scm_y Coordinate Y of the symbol.
 *  \param [in] angle Angle of rotation of the symbol.
 *  \param [in] selectable True if the symbol is selectable, false otherwise.
 *  \param [in] mirror True if the symbol is mirrored, false otherwise.
 *  If scm_comp_name is a scheme empty list, SCM_BOOL_F, or an empty
 *  string (""), then g_add_component returns SCM_BOOL_F without writing
 *  to the log.
 *  \return TRUE if the component was added, FALSE otherwise.
 *
 */
SCM g_add_component(SCM page_smob, SCM scm_comp_name, SCM scm_x, SCM scm_y,
                    SCM scm_angle, SCM scm_selectable, SCM scm_mirror)
{
    TOPLEVEL *toplevel;
    PAGE *page;
    gboolean selectable, mirror;
    gchar *comp_name;
    int x, y, angle;
    OBJECT *new_obj;
    const CLibSymbol *clib;

    /* Return if scm_comp_name is NULL (an empty list) or scheme's FALSE */
    if (SCM_NULLP(scm_comp_name) ||
            (SCM_BOOLP(scm_comp_name) && !(SCM_NFALSEP(scm_comp_name))) ) {
        return SCM_BOOL_F;
    }

    /* Get toplevel and the page */
    SCM_ASSERT (g_get_data_from_page_smob (page_smob, &toplevel, &page),
                page_smob, SCM_ARG1, "add-component-at-xy");
    /* Check the arguments */
    SCM_ASSERT (scm_is_string(scm_comp_name), scm_comp_name,
                SCM_ARG2, "add-component-at-xy");
    SCM_ASSERT ( scm_is_integer(scm_x), scm_x,
                 SCM_ARG3, "add-component-at-xy");
    SCM_ASSERT ( scm_is_integer(scm_y), scm_y,
                 SCM_ARG4, "add-component-at-xy");
    SCM_ASSERT ( scm_is_integer(scm_angle), scm_angle,
                 SCM_ARG5, "add-component-at-xy");
    SCM_ASSERT ( scm_boolean_p(scm_selectable), scm_selectable,
                 SCM_ARG6, "add-component-at-xy");
    SCM_ASSERT ( scm_boolean_p(scm_mirror), scm_mirror,
                 SCM_ARG7, "add-component-at-xy");

    /* Get the parameters */
    comp_name = SCM_STRING_CHARS(scm_comp_name);
    x = scm_to_int(scm_y);
    y = scm_to_int(scm_y);
    angle = scm_to_int(scm_angle);
    selectable = SCM_NFALSEP(scm_selectable);
    mirror = SCM_NFALSEP(scm_mirror);

    SCM_ASSERT (comp_name, scm_comp_name,
                SCM_ARG2, "add-component-at-xy");

    if (strcmp(comp_name, "") == 0) {
        return SCM_BOOL_F;
    }

    clib = s_clib_get_symbol_by_name (comp_name);

    new_obj = o_complex_new (toplevel, 'C', DEFAULT_COLOR, x, y, angle, mirror,
                             clib, comp_name, selectable);
    s_page_append_list (page, o_complex_promote_attribs (toplevel, new_obj));
    s_page_append (page, new_obj);

    /*
     * For now, do not redraw the newly added complex, since this might cause
     * flicker if you are zoom/panning right after this function executes
     */
#if 0
    /* Now the new component should be added to the object's list and
       drawn in the screen */
    o_invalidate (toplevel, new_object);
#endif

    return SCM_BOOL_T;
}
Esempio n. 10
0
/*
 * Adds an attribute <B>scm_attrib_name</B> with value <B>scm_attrib_value</B> to the given <B>object</B>.
The attribute has the visibility <B>scm_vis</B> and show <B>scm_show</B> flags.
The possible values are:
  - <B>scm_vis</B>: scheme boolean. Visible (TRUE) or hidden (FALSE).
  - <B>scm_show</B>: a list containing what to show: "name", "value", or both.
The return value is always TRUE.
 */
SCM g_add_attrib(SCM object, SCM scm_attrib_name,
                 SCM scm_attrib_value, SCM scm_vis, SCM scm_show)
{
    GSCHEM_TOPLEVEL *w_current=global_window_current;
    TOPLEVEL *toplevel = w_current->toplevel;
    OBJECT *o_current=NULL;
    gboolean vis;
    int show=0;
    gchar *attrib_name=NULL;
    gchar *attrib_value=NULL;
    gchar *value=NULL;
    int i;
    gchar *newtext=NULL;

    SCM_ASSERT (scm_is_string(scm_attrib_name), scm_attrib_name,
                SCM_ARG2, "add-attribute-to-object");
    SCM_ASSERT (scm_is_string(scm_attrib_value), scm_attrib_value,
                SCM_ARG3, "add-attribute-to-object");
    SCM_ASSERT (scm_boolean_p(scm_vis), scm_vis,
                SCM_ARG4, "add-attribute-to-object");
    SCM_ASSERT (scm_list_p(scm_show), scm_show,
                SCM_ARG5, "add-attribute-to-object");

    /* Get toplevel and o_current */
    SCM_ASSERT (g_get_data_from_object_smob (object, &toplevel, &o_current),
                object, SCM_ARG1, "add-attribute-to-object");

    /* Get parameters */
    attrib_name = SCM_STRING_CHARS(scm_attrib_name);
    attrib_value = SCM_STRING_CHARS(scm_attrib_value);
    vis = SCM_NFALSEP(scm_vis);

    for (i=0; i<=scm_to_int(scm_length(scm_show))-1; i++) {
        /* Check every element in the list. It should be a string! */
        SCM_ASSERT(scm_list_ref(scm_show, scm_from_int(i)),
                   scm_show,
                   SCM_ARG5, "add-attribute-to-object");
        SCM_ASSERT(scm_is_string(scm_list_ref(scm_show, scm_from_int(i))),
                   scm_show,
                   SCM_ARG5, "add-attribute-to-object");

        value = SCM_STRING_CHARS(scm_list_ref(scm_show, scm_from_int(i)));

        SCM_ASSERT(value, scm_show,
                   SCM_ARG5, "add-attribute-to-object");

        /* Only "name" or "value" strings are allowed */
        SCM_ASSERT(!((strcasecmp(value, "name") != 0) &&
                     (strcasecmp(value, "value") != 0) ), scm_show,
                   SCM_ARG5, "add-attribute-to-object");

        /* show = 1 => show value;
           show = 2 => show name;
           show = 3 => show both */
        if (strcasecmp(value, "value") == 0) {
            show |= 1;
        }
        else if (strcasecmp(value, "name") == 0) {
            show |= 2;
        }
    }
    /* Show name and value (show = 3) => show=0 for gschem */
    if (show == 3) {
        show = 0;
    }

    newtext = g_strdup_printf("%s=%s", attrib_name, attrib_value);
    o_attrib_add_attrib (w_current, newtext, vis, show, o_current);
    g_free(newtext);

    return SCM_BOOL_T;

}
Esempio n. 11
0
int scm_is_true(SCM x) {
	return SCM_NFALSEP (x);
}
Esempio n. 12
0
int scm_to_bool(SCM x) {
	return SCM_NFALSEP(x);
}