/* 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); }
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 (¤t_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; }