Exemplo n.º 1
0
/* Create a new plotter whose output and error are Guile ports */
SCM
gupl_newpl (SCM type, SCM outp, SCM errp, SCM param)
{
  char *c_type;
  FILE *c_outp, *c_errp;
  plPlotter *ret;
  plPlotterParams *c_param;

  SCM_ASSERT (scm_is_string (type), type, SCM_ARG1, "newpl");
  SCM_ASSERT (scm_is_true (scm_output_port_p (outp)), outp, SCM_ARG2,
	      "newpl");
  SCM_ASSERT (scm_is_true (scm_output_port_p (errp)), errp, SCM_ARG3, "newpl");
  SCM_ASSERT (_scm_is_plparams (param), param, SCM_ARG4, "newpl");

  /* Convert the output port to a special stream */
  c_outp = fopencookie (SCM2PTR (outp), "wb", port_funcs);

  /* Don't buffer port here, since the underlying Guile port also has
     port buffering.  Double buffering causes problems.  */

  setvbuf (c_outp, NULL, _IONBF, 0);
  if (c_outp == NULL)
    scm_syserror ("newpl");

  /* Convert the err port to a special stream */
  c_errp = fopencookie (SCM2PTR (errp), "wb", port_funcs);
  if (c_errp == NULL)
    scm_out_of_range ("newpl", errp);
  setvbuf (c_errp, NULL, _IONBF, 0);

  c_type = scm_to_locale_string (type);
  c_param = _scm_to_plparams (param);

  ret = pl_newpl_r (c_type, NULL, c_outp, c_errp, c_param);

  free (c_type);

  if (ret == NULL)
    return SCM_BOOL_F;

  return _scm_from_plotter (ret);
}
Exemplo n.º 2
0
static SCM
ioscm_with_output_to_port_worker (SCM port, SCM thunk, enum oport oport,
				  const char *func_name)
{
  struct ui_file *port_file;
  struct cleanup *cleanups;
  SCM result;

  SCM_ASSERT_TYPE (gdbscm_is_true (scm_output_port_p (port)), port,
		   SCM_ARG1, func_name, _("output port"));
  SCM_ASSERT_TYPE (gdbscm_is_true (scm_thunk_p (thunk)), thunk,
		   SCM_ARG2, func_name, _("thunk"));

  cleanups = set_batch_flag_and_make_cleanup_restore_page_info ();

  make_cleanup_restore_integer (&current_ui->async);
  current_ui->async = 0;

  port_file = ioscm_file_port_new (port);

  make_cleanup_ui_file_delete (port_file);

  scoped_restore save_file = make_scoped_restore (oport == GDB_STDERR
						  ? &gdb_stderr : &gdb_stdout);

  if (oport == GDB_STDERR)
    gdb_stderr = port_file;
  else
    {
      if (ui_out_redirect (current_uiout, port_file) < 0)
	warning (_("Current output protocol does not support redirection"));
      else
	make_cleanup_ui_out_redirect_pop (current_uiout);

      gdb_stdout = port_file;
    }

  result = gdbscm_safe_call_0 (thunk, NULL);

  do_cleanups (cleanups);

  if (gdbscm_is_exception (result))
    gdbscm_throw (result);

  return result;
}