/*! \todo Finish function description!!!
* \brief
* \par Function Description
*
* \param [in] width
* \param [in] height
* \param [in] border
* \return SCM_BOOL_T always.
*/
SCM g_rc_world_size(SCM width, SCM height, SCM border)
#define FUNC_NAME "world-size"
{
int i_width, i_height, i_border;
int init_right, init_bottom;
SCM_ASSERT (SCM_NIMP (width) && SCM_REALP (width), width,
SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (height) && SCM_REALP (height), height,
SCM_ARG2, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (border) && SCM_REALP (border), border,
SCM_ARG3, FUNC_NAME);
/* yes this is legit, we are casing the resulting double to an int */
i_width = (int) (scm_to_double (width) * MILS_PER_INCH);
i_height = (int) (scm_to_double (height) * MILS_PER_INCH);
i_border = (int) (scm_to_double (border) * MILS_PER_INCH);
PAPERSIZEtoWORLD(i_width, i_height, i_border,
&init_right, &init_bottom);
#if DEBUG
printf("%d %d\n", i_width, i_height);
printf("%d %d\n", init_right, init_bottom);
#endif
default_init_right = init_right;
default_init_bottom = init_bottom;
return SCM_BOOL_T;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_paper_sizes(SCM scm_papername, SCM scm_width, SCM scm_height)
#define FUNC_NAME "paper-sizes"
{
int width;
int height;
char *papername;
SCM ret;
SCM_ASSERT (scm_is_string (scm_papername), scm_papername,
SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (scm_width) && SCM_REALP (scm_width), scm_width,
SCM_ARG2, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (scm_height) && SCM_REALP (scm_height), scm_height,
SCM_ARG3, FUNC_NAME);
papername = SCM_STRING_CHARS (scm_papername);
width = (int) (SCM_NUM2DOUBLE (0, scm_width) * MILS_PER_INCH);
height = (int) (SCM_NUM2DOUBLE (0, scm_height) * MILS_PER_INCH);
if (!s_papersizes_uniq(papername)) {
ret = SCM_BOOL_F;
} else {
s_papersizes_add_entry(papername, width, height);
ret = SCM_BOOL_T;
}
return ret;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_paper_size(SCM width, SCM height)
#define FUNC_NAME "paper-size"
{
SCM_ASSERT (SCM_NIMP (width) && SCM_REALP (width), width,
SCM_ARG1, FUNC_NAME);
SCM_ASSERT (SCM_NIMP (height) && SCM_REALP (height), height,
SCM_ARG2, FUNC_NAME);
/* yes this is legit, we are casting the resulting double to an int */
default_paper_width = (int) (SCM_NUM2DOUBLE (0, width) * MILS_PER_INCH);
default_paper_height = (int) (SCM_NUM2DOUBLE (0, height) * MILS_PER_INCH);
return SCM_BOOL_T;
}
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;
}
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);
}
}
boolean cur_fieldp(SCM obj)
{
if (SCM_NIMP(obj) && SCM_SYMBOLP(obj)) {
char *s = ctl_symbol2newstr(obj);
int ret = !strcmp(s, "cur-field");
free(s);
return ret;
}
return 0;
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_add_menu(SCM menu_name, SCM menu_items)
{
SCM_ASSERT (scm_is_string (menu_name), menu_name,
SCM_ARG1, "add-menu");
SCM_ASSERT (SCM_NIMP (menu_items) && SCM_CONSP (menu_items), menu_items,
SCM_ARG2, "add-menu");
s_menu_add_entry(SCM_STRING_CHARS (menu_name), menu_items);
return SCM_BOOL_T;
}
/*
* FIXME: If we clean up at exit, removing the registered functions, we get
* rid of the 'Leaking string [Guile] with ref_count=1' warnings. The way we
* do this for other plugins, including Python, we deactivate the
* plugin. However, it is not possible to finalize Guile.
*/
static SCM
scm_register_function (SCM scm_name, SCM scm_args, SCM scm_help, SCM scm_category, SCM scm_function)
{
GnmFunc *fndef;
GnmFuncGroup *cat;
GnmFuncDescriptor desc;
char *help;
SCM_ASSERT (SCM_NIMP (scm_name) && SCM_STRINGP (scm_name), scm_name, SCM_ARG1, "scm_register_function");
SCM_ASSERT (SCM_NIMP (scm_args) && SCM_STRINGP (scm_args), scm_args, SCM_ARG2, "scm_register_function");
SCM_ASSERT (SCM_NIMP (scm_help) && SCM_STRINGP (scm_help), scm_help, SCM_ARG3, "scm_register_function");
SCM_ASSERT (SCM_NIMP (scm_category) && SCM_STRINGP (scm_category),
scm_category, SCM_ARG4, "scm_register_function");
SCM_ASSERT (scm_procedure_p (scm_function), scm_function, SCM_ARG5, "scm_register_function");
scm_permanent_object (scm_function);
desc.name = g_strdup (SCM_CHARS (scm_name));
desc.arg_spec = g_strdup (SCM_CHARS (scm_args));
desc.arg_names = NULL;
help = g_strdup (SCM_CHARS (scm_help));
desc.help = &help;
desc.fn_args = func_marshal_func;
desc.fn_nodes = NULL;
desc.linker = NULL;
desc.unlinker = NULL;
desc.flags = 0;
desc.ref_notify = NULL;
desc.impl_status = GNM_FUNC_IMPL_STATUS_UNIQUE_TO_GNUMERIC;
desc.test_status = GNM_FUNC_TEST_STATUS_UNKNOWN;
cat = gnm_func_group_fetch (SCM_CHARS (scm_category), NULL);
fndef = gnm_func_add (cat, &desc, NULL);
gnm_func_set_user_data (fndef, GINT_TO_POINTER (scm_function));
return SCM_UNSPECIFIED;
}
SCM
scm_oldfmt (SCM s)
{
#ifdef HAVE_SCM_SIMPLE_FORMAT
return s;
#else
int n;
SCM_ASSERT (SCM_NIMP (s) && SCM_STRINGP (s), s, 1, s_oldfmt);
n = SCM_LENGTH (s);
return scm_return_first (scm_mem2string (scm_c_oldfmt (SCM_ROCHARS (s), n),
n),
s);
#endif
}
/*! \todo Finish function documentation!!!
* \brief
* \par Function Description
*
*/
SCM g_rc_add_menu(SCM scm_menu_name, SCM scm_menu_items)
{
char *menu_name;
SCM_ASSERT (scm_is_string (scm_menu_name), scm_menu_name,
SCM_ARG1, "add-menu");
SCM_ASSERT (SCM_NIMP (scm_menu_items) && SCM_CONSP (scm_menu_items), scm_menu_items,
SCM_ARG2, "add-menu");
menu_name = scm_to_utf8_string (scm_menu_name);
s_menu_add_entry(menu_name, scm_menu_items);
free (menu_name);
return SCM_BOOL_T;
}
int
mu_scm_is_body (SCM scm)
{
return SCM_NIMP (scm) && (long) SCM_CAR (scm) == body_tag;
}
static gboolean
mu_guile_scm_is_msg (SCM scm)
{
return SCM_NIMP(scm) && (long)SCM_CAR(scm) == MSG_TAG;
}
int
mu_scm_is_mailbox (SCM scm)
{
return SCM_NIMP (scm) && (long) SCM_CAR (scm) == mailbox_tag;
}
static int
supports_source_props (SCM obj)
{
return SCM_NIMP (obj) && !scm_is_symbol (obj) && !scm_is_keyword (obj);
}
