C++ SCM_CDR函数代码示例

static void
scm_scmlist_print (LONGEST svalue, struct ui_file *stream, int format,
		   int deref_ref, int recurse, enum val_prettyprint pretty)
{
  unsigned int more = print_max;
  if (recurse > 6)
    {
      fputs_filtered ("...", stream);
      return;
    }
  scm_scmval_print (SCM_CAR (svalue), stream, format,
		    deref_ref, recurse + 1, pretty);
  svalue = SCM_CDR (svalue);
  for (; SCM_NIMP (svalue); svalue = SCM_CDR (svalue))
    {
      if (SCM_NECONSP (svalue))
	break;
      fputs_filtered (" ", stream);
      if (--more == 0)
	{
	  fputs_filtered ("...", stream);
	  return;
	}
      scm_scmval_print (SCM_CAR (svalue), stream, format,
			deref_ref, recurse + 1, pretty);
    }
  if (SCM_NNULLP (svalue))
    {
      fputs_filtered (" . ", stream);
      scm_scmval_print (svalue, stream, format,
			deref_ref, recurse + 1, pretty);
    }
}

static SCM
decode_scm_col_list (GttGhtml *ghtml, SCM col_list)
{
	SCM col_name;
	char * tok = NULL;

	/* reset the parser */
	ghtml->ninvl_cols = 0;
	ghtml->ntask_cols = 0;
		
	while (!scm_is_null (col_list))
	{
		col_name = SCM_CAR (col_list);

		/* either a 'symbol or a "quoted string" */
		if (!scm_is_symbol(col_name) && !scm_is_string (col_name))
		{
			col_list = SCM_CDR (col_list);
			continue;
		}
		tok = scm_to_locale_string (col_name);
		decode_column (ghtml, tok);

		free (tok);
		col_list = SCM_CDR (col_list);
	}

	return SCM_UNSPECIFIED;
}

/*! \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;
}

SWIGINTERN int
SWIG_Guile_GetArgs (SCM *dest, SCM rest,
		    int reqargs, int optargs,
		    const char *procname)
{
  int i;
  int num_args_passed = 0;
  for (i = 0; i<reqargs; i++) {
    if (!SCM_CONSP(rest))
      scm_wrong_num_args(scm_from_locale_string((char *) procname));
    *dest++ = SCM_CAR(rest);
    rest = SCM_CDR(rest);
    num_args_passed++;
  }
  for (i = 0; i<optargs && SCM_CONSP(rest); i++) {
    *dest++ = SCM_CAR(rest);
    rest = SCM_CDR(rest);
    num_args_passed++;
  }
  for (; i<optargs; i++)
    *dest++ = SCM_UNDEFINED;
  if (!SCM_NULLP(rest))
    scm_wrong_num_args(scm_from_locale_string((char *) procname));
  return num_args_passed;
}

static void message_args_set(ScmMessageCondition *obj, ScmObj val)
{
    ScmObj msglist = obj->message;
    if (SCM_PAIRP(msglist) && SCM_PAIRP(SCM_CDR(msglist))) {
        SCM_SET_CDR(SCM_CDR(msglist), val);
    } else {
        obj->message = Scm_Cons(msglist, Scm_Cons(msglist, val));
    }
}

static void message_prefix_set(ScmMessageCondition *obj, ScmObj val)
{
    ScmObj msglist = obj->message;
    if (SCM_PAIRP(msglist) && SCM_PAIRP(SCM_CDR(msglist))) {
        SCM_SET_CAR(SCM_CDR(msglist), val);
    } else {
        obj->message = SCM_LIST2(msglist, val);
    }
}

ScmObj Scm_GetKeyword(ScmObj key, ScmObj list, ScmObj fallback)
{
    ScmObj cp;
    SCM_FOR_EACH(cp, list) {
        if (!SCM_PAIRP(SCM_CDR(cp))) {
            Scm_Error("incomplete key list: %S", list);
        }
        if (key == SCM_CAR(cp)) return SCM_CADR(cp);
        cp = SCM_CDR(cp);
    }
    if (SCM_UNBOUNDP(fallback)) {
        Scm_Error("value for key %S is not provided: %S", key, list);
    }
    return fallback;
}

GList *
gnc_scm_list_to_glist(SCM rest)
{
    GList *result = NULL;
    SCM scm_item;

    SWIG_GetModule(NULL); /* Work-around for SWIG bug. */
    SCM_ASSERT(scm_is_list(rest), rest, SCM_ARG1, "gnc_scm_list_to_glist");

    while (!scm_is_null(rest))
    {
        void *item;

        scm_item = SCM_CAR(rest);
        rest = SCM_CDR(rest);

        if (scm_item == SCM_BOOL_F)
        {
            result = g_list_prepend(result, NULL);
        }
        else
        {
            if (!SWIG_IsPointer(scm_item))
                scm_misc_error("gnc_scm_list_to_glist",
                               "Item in list not a wcp.", scm_item);

            item = (void *)SWIG_PointerAddress(scm_item);
            result = g_list_prepend(result, item);
        }
    }

    return g_list_reverse(result);
}

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

SCM
scm_make_srcprops (long line, int col, SCM filename, SCM copy, SCM alist)
{
  if (!SCM_UNBNDP (filename))
    {
      SCM old_alist = alist;

      /*
	have to extract the acons, and operate on that, for
	thread safety.
       */
      SCM last_acons = SCM_CDR (scm_last_alist_filename);
      if (scm_is_null (old_alist)
	  && scm_is_eq (SCM_CDAR (last_acons), filename))
	{
	  alist = last_acons;
	}
      else
	{
	  alist = scm_acons (scm_sym_filename, filename, alist);
	  if (scm_is_null (old_alist))
	    scm_set_cdr_x (scm_last_alist_filename, alist);
	}
    }
  
  SCM_RETURN_NEWSMOB3 (scm_tc16_srcprops,
		       SRCPROPMAKPOS (line, col),
		       SCM_UNPACK (copy),
		       SCM_UNPACK (alist));
}

GncAccountValue * gnc_scm_to_account_value_ptr (SCM valuearg)
{
    GncAccountValue *res;
    Account *acc = NULL;
    gnc_numeric value;
    swig_type_info * account_type = get_acct_type();
    SCM val;

    /* Get the account */
    val = SCM_CAR (valuearg);
    if (!SWIG_IsPointerOfType (val, account_type))
        return NULL;

    acc = SWIG_MustGetPtr(val, account_type, 1, 0);

    /* Get the value */
    val = SCM_CDR (valuearg);
    value = gnc_scm_to_numeric (val);

    /* Build and return the object */
    res = g_new0 (GncAccountValue, 1);
    res->account = acc;
    res->value = value;
    return res;
}

static SCM make_doc(SCM ingredients, SCM recipe) {
	MAKE_NODE *node;
	FILE_NODE *fnode;
	SCM smob, cursor;
	if (scm_is_symbol(ingredients)) {
		if (ingredients == file_sym) {
			node = make_node(TYPE_FILE);
			node->filepath = scm_to_locale_string(recipe);
			node->dirty = 1;
			fnode = (FILE_NODE *)malloc(sizeof(FILE_NODE));
			fnode->node = node;
			fnode->mtime = 0;
			fnode->next = file_nodes;
			file_nodes = fnode;
			}
		else {
			node = make_node(TYPE_DATUM);
			node->dirty = 0;
			node->payload = recipe;
			}
		SCM_RETURN_NEWSMOB(make_node_tag, node);
		}
	node = make_node(TYPE_CHAIN);
	node->dirty = 1;
	node->callback = recipe;
	SCM_NEWSMOB(smob, make_node_tag, node);
	cursor = ingredients;
	while (cursor != SCM_EOL) {
		add_ascendant(SCM_CAR(cursor), smob);
		cursor = SCM_CDR(cursor);
		}
	scm_remember_upto_here_2(ingredients, recipe);
	scm_remember_upto_here_2(smob, cursor);
	return smob;
	}

/*! \todo Finish function documentation!!!
 *  \brief
 *  \par Function Description
 *
 */
SCM g_funcs_filesel(SCM scm_msg, SCM scm_templ, SCM scm_flags)
{
  int c_flags;
  char *r, *msg, *templ;
  SCM v;

  SCM_ASSERT (scm_is_string (scm_msg), scm_msg,
	      SCM_ARG1, "gschem-filesel");
  
  SCM_ASSERT (scm_is_string (scm_templ), scm_templ,
	      SCM_ARG2, "gschem-filesel");
  
  /*! \bug FIXME -- figure out the magic SCM_ASSERT for the flags */

  /*! \bug FIXME -- how to deal with conflicting flags? 
   * Should I throw a scheme error?  Just deal in the c code?
   */
  for (c_flags = 0; scm_is_pair (scm_flags); scm_flags = SCM_CDR (scm_flags)) {
    char *flag;
    SCM scm_flag = SCM_CAR (scm_flags);

    flag = scm_to_utf8_string (scm_flag);
    if (strcmp (flag, "may_exist") == 0) {
      c_flags |= FSB_MAY_EXIST;

    } else if (strcmp (flag, "must_exist") == 0) {
      c_flags |= FSB_MUST_EXIST;
      
    } else if (strcmp (flag, "must_not_exist") == 0) {
      c_flags |= FSB_SHOULD_NOT_EXIST;

    } else if (strcmp (flag, "save") == 0) {
      c_flags |= FSB_SAVE;

    } else if (strcmp (flag, "open") == 0) {
      c_flags |= FSB_LOAD;

    } else {
      free(flag);
      scm_wrong_type_arg ("gschem-filesel", SCM_ARG3, scm_flag);
    }
    free(flag);
  }

  msg = scm_to_utf8_string (scm_msg);
  templ = scm_to_utf8_string (scm_templ);

  r = generic_filesel_dialog (msg, templ, c_flags);

  free(msg);
  free(templ);

  v = scm_from_utf8_string (r);
  g_free (r);

  return v;
}

static scm_sizet
mu_scm_body_free (SCM body_smob)
{
  struct mu_body *mbp = (struct mu_body *) SCM_CDR (body_smob);
  if (mbp->buffer)
    free (mbp->buffer);
  free (mbp);
  return sizeof (struct mu_body);
}

static ScmObj message_args_get(ScmMessageCondition *obj)
{
    ScmObj msglist = obj->message;
    if (SCM_PAIRP(msglist) && SCM_PAIRP(SCM_CDR(msglist))) {
        return SCM_CDDR(msglist);
    } else {
        return SCM_NIL;
    }
}