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