static void
syntax_error (const char* const msg, const SCM form, const SCM expr)
{
SCM msg_string = scm_from_locale_string (msg);
SCM filename = SCM_BOOL_F;
SCM linenr = SCM_BOOL_F;
const char *format;
SCM args;
if (scm_is_pair (form))
{
filename = scm_source_property (form, scm_sym_filename);
linenr = scm_source_property (form, scm_sym_line);
}
if (scm_is_false (filename) && scm_is_false (linenr) && scm_is_pair (expr))
{
filename = scm_source_property (expr, scm_sym_filename);
linenr = scm_source_property (expr, scm_sym_line);
}
if (!SCM_UNBNDP (expr))
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S in expression ~S.";
args = scm_list_5 (filename, linenr, msg_string, form, expr);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S in expression ~S.";
args = scm_list_4 (linenr, msg_string, form, expr);
}
else
{
format = "~A ~S in expression ~S.";
args = scm_list_3 (msg_string, form, expr);
}
}
else
{
if (scm_is_true (filename))
{
format = "In file ~S, line ~S: ~A ~S.";
args = scm_list_4 (filename, linenr, msg_string, form);
}
else if (scm_is_true (linenr))
{
format = "In line ~S: ~A ~S.";
args = scm_list_3 (linenr, msg_string, form);
}
else
{
format = "~A ~S.";
args = scm_list_2 (msg_string, form);
}
}
scm_error (syntax_error_key, "memoization", format, args, SCM_BOOL_F);
}
static SCM
scm_type_symbol_to_AnchorPointType (SCM symb, SCM who)
{
int type = INT_MIN;
if (scm_is_eq (symb, scm_symbol__mark ()))
type = at_mark;
else if (scm_is_eq (symb, scm_symbol__base ()))
type = at_basechar;
else if (scm_is_eq (symb, scm_symbol__ligature ()))
type = at_baselig;
else if (scm_is_eq (symb, scm_symbol__base_mark ()))
type = at_basemark;
else if (scm_is_eq (symb, scm_symbol__entry ()))
type = at_centry;
else if (scm_is_eq (symb, scm_symbol__exit ()))
type = at_cexit;
else
{
if (SCM_UNBNDP (who))
who = scm_from_latin1_string ("scm_type_symbol_to_AnchorPointType");
rnrs_raise_condition
(scm_list_4
(rnrs_make_assertion_violation (),
rnrs_make_who_condition (who),
rnrs_c_make_message_condition (_("unrecognized anchor point type")),
rnrs_make_irritants_condition (scm_list_1 (symb))));
}
return scm_from_int (type);
}
SCM
yacl_scm_gen_p256_key_pair (void)
{
int rc;
uint8_t q[YACL_P256_COORD_SIZE*2];
uint8_t d[YACL_P256_COORD_SIZE];
rc = yacl_create_key_pair(q, d);
SCM qs = scm_c_make_bytevector (YACL_SHA256_LEN*2);
SCM ds = scm_c_make_bytevector (YACL_SHA256_LEN);
memcpy (SCM_BYTEVECTOR_CONTENTS (qs), &q, YACL_SHA256_LEN*2);
memcpy (SCM_BYTEVECTOR_CONTENTS (ds), &d, YACL_SHA256_LEN);
SCM q_list = scm_list_2 (scm_from_locale_symbol ("q"), qs);
SCM d_list = scm_list_2 (scm_from_locale_symbol ("d"), ds);
SCM curve_list = scm_list_2 (scm_from_locale_symbol ("curve"),
scm_from_locale_string("NIST P-256"));
SCM l = scm_list_4 (scm_from_locale_symbol ("ecc"),
curve_list,
q_list,
d_list);
SCM pri_key = scm_list_2 (scm_from_locale_symbol ("private-key"),
l);
return pri_key;
}
VISIBLE void
scm_gsl_error_handler_for_raising_a_gsl_error (const char *reason,
const char *file,
int line, int gsl_errno)
{
scm_raise_gsl_error (scm_list_4 (scm_from_locale_string (reason),
scm_from_locale_string (file),
scm_from_int (line),
scm_from_int (gsl_errno)));
}
bool mouseAreaMouseUp(guihckContext* ctx, guihckElementId id, void* data, int button, float x, float y)
{
(void) data;
(void) button;
(void) x;
(void) y;
bool handled = false;
SCM pressed = guihckElementGetProperty(ctx, id, "pressed");
bool clicked = scm_to_bool(pressed);
guihckElementProperty(ctx, id, "pressed", SCM_BOOL_F);
{
SCM handler = guihckElementGetProperty(ctx, id, "on-mouse-up");
if(scm_to_bool(scm_procedure_p(handler)))
{
guihckStackPushElement(ctx, id);
SCM expression = scm_list_4(handler, scm_from_int8(button), scm_from_double(x), scm_from_double(y));
SCM result = guihckContextExecuteExpression(ctx, expression);
handled = scm_is_eq(result, SCM_BOOL_T);
guihckStackPopElement(ctx);
}
}
if(clicked && !handled)
{
SCM handler = guihckElementGetProperty(ctx, id, "on-click");
if(scm_to_bool(scm_procedure_p(handler)))
{
guihckStackPushElement(ctx, id);
SCM expression = scm_list_4(handler, scm_from_int8(button), scm_from_double(x), scm_from_double(y));
SCM result = guihckContextExecuteExpression(ctx, expression);
handled = scm_is_eq(result, SCM_BOOL_T);
guihckStackPopElement(ctx);
}
}
return handled;
}
static void
the_new_degree_is_not_an_elevation (const char *who, SCM new_degree,
SCM old_degree, SCM spline)
{
const char *localized_message =
_("the new degree ~a is less than the old degree ~a");
SCM message = scm_sformat (scm_from_locale_string (localized_message),
scm_list_2 (new_degree, old_degree));
rnrs_raise_condition
(scm_list_4
(rnrs_make_assertion_violation (), rnrs_c_make_who_condition (who),
rnrs_make_message_condition (message),
rnrs_make_irritants_condition (scm_list_2 (new_degree, spline))));
}
/* returns a (sec . usec) pair. It throws an 'a-sync-exception guile
exception if the library has been configured for monotonic time at
configuration time but it is not in fact supported, but this is not
worth testing for by user code as it should never happen - the
library configuration macros should always give the correct
answer */
static SCM get_time(void) {
#ifdef HAVE_MONOTONIC_CLOCK
struct timespec ts;
if (clock_gettime(CLOCK_MONOTONIC, &ts) == -1) {
scm_throw(scm_from_latin1_symbol("a-sync-exception"),
scm_list_4(scm_from_latin1_string("get-time"),
scm_from_latin1_string("guile-a-sync2: ~A"),
scm_list_1(scm_from_latin1_string("monotonic time not supported "
"by underlying implementation")),
scm_from_int(errno)));
}
return scm_cons(scm_from_size_t(ts.tv_sec), scm_from_long(ts.tv_nsec/1000L));
#else
return scm_gettimeofday();
#endif
}
static _t1font_key_t
t1font_key (const char *who, const char *key_string)
{
_t1font_key_t k = 0;
while (k < _t1font_SENTINEL && strcmp (key_string, t1font_key_table[k]) != 0)
k++;
if (k == _t1font_SENTINEL)
rnrs_raise_condition
(scm_list_4
(rnrs_make_assertion_violation (),
rnrs_c_make_who_condition (who),
rnrs_c_make_message_condition (_("unsupported Type1 font dict key")),
rnrs_make_irritants_condition
(scm_list_1 (scm_from_utf8_string (key_string)))));
return k;
}
static SCM
scm_AnchorPointType_to_type_symbol (SCM type, SCM who)
{
SCM symb = SCM_UNSPECIFIED;
const int _type = scm_to_int (type);
switch (_type)
{
case at_mark:
symb = scm_symbol__mark ();
break;
case at_basechar:
symb = scm_symbol__base ();
break;
case at_baselig:
symb = scm_symbol__ligature ();
break;
case at_basemark:
symb = scm_symbol__base_mark ();
break;
case at_centry:
symb = scm_symbol__entry ();
break;
case at_cexit:
symb = scm_symbol__exit ();
break;
default:
{
if (SCM_UNBNDP (who))
who = scm_from_latin1_string ("scm_AnchorPointType_to_type_symbol");
rnrs_raise_condition
(scm_list_4
(rnrs_make_assertion_violation (),
rnrs_make_who_condition (who),
rnrs_c_make_message_condition (_("unrecognized AnchorPointType "
"value")),
rnrs_make_irritants_condition (scm_list_1 (type))));
}
break;
}
return symb;
}
SCM
gdbscm_make_error_scm (SCM key, SCM subr, SCM message, SCM args, SCM data)
{
return gdbscm_make_exception (key, scm_list_4 (subr, message, args, data));
}
"@code{system-error} then it should be a list containing the\n"
"Unix @code{errno} value; If @var{key} is @code{signal} then it\n"
"should be a list containing the Unix signal number; If\n"
"@var{key} is @code{out-of-range} or @code{wrong-type-arg},\n"
"it is a list containing the bad value; otherwise\n"
"it will usually be @code{#f}.")
#define FUNC_NAME s_scm_error_scm
{
if (scm_gc_running_p)
{
/* The error occured during GC --- abort */
fprintf (stderr, "Guile: error during GC.\n"),
abort ();
}
scm_ithrow (key, scm_list_4 (subr, message, args, data), 1);
/* No return, but just in case: */
fprintf (stderr, "Guile scm_ithrow returned!\n");
exit (EXIT_FAILURE);
}
#undef FUNC_NAME
/* strerror may not be thread safe, for instance in glibc (version 2.3.2) an
error number not among the known values results in a string like "Unknown
error 9999" formed in a static buffer, which will be overwritten by a
similar call in another thread. A test program running two threads with
different unknown error numbers can trip this fairly quickly.
Some systems don't do what glibc does, instead just giving a single
"Unknown error" for unrecognised numbers. It doesn't seem worth trying
static PyObject *
pyscm_PySCM_call(pyscm_PySCMObject *self, PyObject *args, PyObject *kwargs)
{
/* Return the result of calling self with argument args */
SCM shandle = scm_hashv_get_handle(pyscm_registration_hash,scm_long2num(self->ob_scm_index));
if (SCM_BOOLP(shandle) && SCM_EQ_P(SCM_BOOL_F,shandle)) {
Py_FatalError("PySCM object lost its associated SCM object"); // NOT COVERED BY TESTS
}
// Now:
// SCM_CADR(shandle) is the SCM object itself
// SCM_CDDR(shandle) is the stemplate.
if (pyguile_verbosity_test(PYGUILE_VERBOSE_PYSCM)) {
scm_simple_format(scm_current_output_port(),scm_makfrom0str("# pyscm_PySCM_call: calling ~S with args=~S and keywords=~S; stemplate=~S\n"),scm_list_4(SCM_CADR(shandle),verbosity_repr(args),verbosity_repr(kwargs),SCM_CDDR(shandle)));
}
SCM sapply_func = GET_APPLY_FUNC(SCM_CDDR(shandle));
if (SCM_EQ_P(SCM_EOL,sapply_func)) {
if (pyguile_verbosity_test(PYGUILE_VERBOSE_PYSCM)) {
scm_simple_format(scm_current_output_port(),scm_makfrom0str("# pyscm_PySCM_call: raising exceptions.TypeError due to \"PySCM wraps a non-callable SCM\"\n"),SCM_EOL);
}
PyErr_SetString(PyExc_TypeError, "PySCM wraps a non-callable SCM");
return(NULL);
}
// Process arguments.
SCM sargs_template = GET_P2G_POSITIONAL_ARGS_TEMPLATE(SCM_CDDR(shandle));
SCM skwargs_template = GET_P2G_KEYWORD_ARGS_TEMPLATE(SCM_CDDR(shandle));
/*if (logical_xor(SCM_EQ_P(SCM_EOL,sargs_template),(NULL==args))
|| logical_xor(SCM_EQ_P(SCM_EOL,skwargs_template),(NULL==kwargs)))*/
// The following allows template to exist without actual arguments.
if ((SCM_EQ_P(SCM_EOL,sargs_template) && (NULL != args))
|| (SCM_EQ_P(SCM_EOL,skwargs_template) && (NULL != kwargs))) {
if (pyguile_verbosity_test(PYGUILE_VERBOSE_PYSCM)) {
scm_simple_format(scm_current_output_port(),scm_makfrom0str("# pyscm_PySCM_call: raising exceptions.TypeError due to \"wrapped SCM does not take some of the provided arguments\"\n"),SCM_EOL);
}
PyErr_SetString(PyExc_TypeError, "wrapped SCM does not take some of the provided arguments");
return(NULL);
}
SCM sargs = SCM_EQ_P(SCM_EOL,sargs_template) || (NULL == args)
? SCM_EOL : p2g_apply(args,sargs_template);
SCM skwargs = SCM_EQ_P(SCM_EOL,skwargs_template) || (NULL == kwargs)
? SCM_EOL : p2g_apply(kwargs,skwargs_template);
SCM sresult = scm_apply(sapply_func,scm_list_2(SCM_CADR(shandle),scm_list_2(sargs,skwargs)),SCM_EOL);
SCM sresult_template = GET_G2P_RESULT_TEMPLATE(SCM_CDDR(shandle));
if (SCM_EQ_P(SCM_EOL,sresult_template)) {
Py_RETURN_NONE;
}
else {
return(g2p_apply(sresult,sresult_template));
}
}
