bool call_guile_keypress(char key, bool ctrl, bool mod1) {
return scm_to_bool (scm_eval (scm_list_n (scm_from_locale_symbol ("on-key-press"),
scm_from_char(key),
scm_from_bool(ctrl),
scm_from_bool(mod1),
SCM_UNDEFINED
), scm_interaction_environment()));
}
static SCM
game_fullscreen (SCM game_smob)
{
Game *game = check_game (game_smob);
return scm_from_bool (al_get_display_flags (game->display) & ALLEGRO_FULLSCREEN);
}
static SCM
gdbscm_stdio_port_p (SCM scm)
{
/* This is copied from SCM_FPORTP. */
return scm_from_bool (!SCM_IMP (scm)
&& (SCM_TYP16 (scm) == stdio_port_desc));
}
static SCM tortoise_penup()
{
SCM result = scm_from_bool(pendown);
pendown = 0;
return result;
}
static SCM
gdbscm_sal_valid_p (SCM self)
{
sal_smob *s_smob = stscm_get_sal_smob_arg (self, SCM_ARG1, FUNC_NAME);
return scm_from_bool (stscm_sal_is_valid (s_smob));
}
static SCM
gdbscm_symbol_valid_p (SCM self)
{
symbol_smob *s_smob
= syscm_get_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
return scm_from_bool (syscm_is_valid (s_smob));
}
static SCM
gdbscm_command_valid_p (SCM self)
{
command_smob *c_smob
= cmdscm_get_command_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
return scm_from_bool (cmdscm_is_valid (c_smob));
}
bool call_guile_buttonpress(unsigned int button, bool ctrl, int x, int y) {
return scm_to_bool (scm_eval (scm_list_n (scm_from_locale_symbol ("on-button-press"),
scm_from_int(button),
scm_from_bool(ctrl),
scm_from_int(x),
scm_from_int(y),
SCM_UNDEFINED
), scm_interaction_environment()));
}
SCM second_pointer_from_offset(void)
{
uint8_t buffer[4] = {2, 3, 5, 7};
uint8_t *p = &buffer[0];
uint8_t *data[2];
int64_t offsets[2] = {3, 2};
pointers_from_offsets(p, offsets, data, 2);
return scm_from_bool(5 == *data[1]);
}
SCM first_pointer_from_offset(void)
{
uint8_t buffer[4] = {2, 3, 5, 7};
uint8_t *p = &buffer[0];
uint8_t *data[1];
int64_t offsets[1] = {3};
pointers_from_offsets(p, offsets, data, 1);
return scm_from_bool(7 == *data[0]);
}
static SCM
gdbscm_symbol_argument_p (SCM self)
{
symbol_smob *s_smob
= syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
const struct symbol *symbol = s_smob->symbol;
return scm_from_bool (SYMBOL_IS_ARGUMENT (symbol));
}
static SCM
gdbscm_set_pretty_printer_enabled_x (SCM self, SCM enabled)
{
pretty_printer_smob *pp_smob
= ppscm_get_pretty_printer_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
pp_smob->enabled = scm_from_bool (gdbscm_is_true (enabled));
return SCM_UNSPECIFIED;
}
static SCM
scm_from_netlist (NETLIST *netlist)
{
return scm_list_n (netlist->component_uref ? scm_from_utf8_string (netlist->component_uref) : SCM_BOOL_F,
netlist->hierarchy_tag ? scm_from_utf8_string (netlist->hierarchy_tag) : SCM_BOOL_F,
scm_from_bool (netlist->composite_component),
netlist->object_ptr ? edascm_from_object (netlist->object_ptr) : SCM_BOOL_F,
scm_from_pin_list (netlist->cpins),
SCM_UNDEFINED);
}
static SCM
gdbscm_symbol_function_p (SCM self)
{
symbol_smob *s_smob
= syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
const struct symbol *symbol = s_smob->symbol;
enum address_class theclass;
theclass = SYMBOL_CLASS (symbol);
return scm_from_bool (theclass == LOC_BLOCK);
}
static SCM wrap_musicpd_play(SCM id) {
bool b;
int mpdid;
b = SCM_BOOL_F;
if(scm_is_integer(id)) {
mpdid = scm_to_int(id);
b = musicpd_play_id(mpdid);
} else {
b = musicpd_play();
}
return scm_from_bool(b);
}
static SCM
gdbscm_symbol_variable_p (SCM self)
{
symbol_smob *s_smob
= syscm_get_valid_symbol_smob_arg_unsafe (self, SCM_ARG1, FUNC_NAME);
const struct symbol *symbol = s_smob->symbol;
enum address_class theclass;
theclass = SYMBOL_CLASS (symbol);
return scm_from_bool (!SYMBOL_IS_ARGUMENT (symbol)
&& (theclass == LOC_LOCAL || theclass == LOC_REGISTER
|| theclass == LOC_STATIC || theclass == LOC_COMPUTED
|| theclass == LOC_OPTIMIZED_OUT));
}
static void
cmdscm_function (struct cmd_list_element *command, char *args, int from_tty)
{
command_smob *c_smob/*obj*/ = (command_smob *) get_cmd_context (command);
SCM arg_scm, tty_scm, result;
gdb_assert (c_smob != NULL);
if (args == NULL)
args = "";
arg_scm = gdbscm_scm_from_string (args, strlen (args), host_charset (), 1);
if (gdbscm_is_exception (arg_scm))
error (_("Could not convert arguments to Scheme string."));
tty_scm = scm_from_bool (from_tty);
result = gdbscm_safe_call_3 (c_smob->invoke, c_smob->containing_scm,
arg_scm, tty_scm, gdbscm_user_error_p);
if (gdbscm_is_exception (result))
{
/* Don't print the stack if this was an error signalled by the command
itself. */
if (gdbscm_user_error_p (gdbscm_exception_key (result)))
{
char *msg = gdbscm_exception_message_to_string (result);
make_cleanup (xfree, msg);
error ("%s", msg);
}
else
{
gdbscm_print_gdb_exception (SCM_BOOL_F, result);
error (_("Error occurred in Scheme-implemented GDB command."));
}
}
}
SCM
gupl_is_plotter_p (SCM x)
{
return scm_from_bool (_scm_is_plotter (x));
}
static SCM
gdbscm_symtab_p (SCM scm)
{
return scm_from_bool (stscm_is_symtab (scm));
}
static SCM
gdbscm_lazy_string_p (SCM scm)
{
return scm_from_bool (lsscm_is_lazy_string (scm));
}
static SCM
gdbscm_command_p (SCM scm)
{
return scm_from_bool (cmdscm_is_command (scm));
}
SCM tf_outputq(SCM scm_value)
{
return scm_from_bool(SCM_SMOB_PREDICATE(tf_output_tag, scm_value));
}
static SCM
gdbscm_frame_p (SCM scm)
{
return scm_from_bool (frscm_is_frame (scm));
}
static SCM
gdbscm_memory_port_p (SCM obj)
{
return scm_from_bool (gdbscm_is_memory_port (obj));
}
static SCM
gdbscm_parameter_p (SCM scm)
{
return scm_from_bool (pascm_is_parameter (scm));
}
static SCM
gdbscm_symbol_p (SCM scm)
{
return scm_from_bool (syscm_is_symbol (scm));
}
static SCM
gdbscm_breakpoint_p (SCM scm)
{
return scm_from_bool (bpscm_is_breakpoint (scm));
}
static SCM
gdbscm_exception_p (SCM scm)
{
return scm_from_bool (gdbscm_is_exception (scm));
}
static SCM
gdbscm_pretty_printer_worker_p (SCM scm)
{
return scm_from_bool (ppscm_is_pretty_printer_worker (scm));
}
static SCM
gdbscm_sal_p (SCM scm)
{
return scm_from_bool (stscm_is_sal (scm));
}
