mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 03:40:34 +02:00
Code Activity

add current-warning-port

Browse source 
* libguile/ports.h:
* libguile/ports.c (scm_current_warning_port)
  (scm_set_current_warning_port): New functions, wrapping the Scheme
  parameter.

* module/ice-9/boot-9.scm (current-warning-port): New parameter,
  defining a port for warnings.
This commit is contained in:
Andy Wingo 2011-06-28 23:24:43 +02:00
parent 13dd74c8ea
commit 3972de7675
3 changed files with 41 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

24
libguile/ports.c
View file

@ -412,6 +412,17 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM
scm_current_warning_port (void)
{
static SCM cwp_var = SCM_BOOL_F;
if (scm_is_false (cwp_var))
cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
return scm_call_0 (scm_variable_ref (cwp_var));
}
SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0, SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0,
(), (),
"Return the current-load-port.\n" "Return the current-load-port.\n"
@ -466,6 +477,19 @@ SCM_DEFINE (scm_set_current_error_port, "set-current-error-port", 1, 0, 0,
} }
#undef FUNC_NAME #undef FUNC_NAME
SCM
scm_set_current_warning_port (SCM port)
{
static SCM cwp_var = SCM_BOOL_F;
if (scm_is_false (cwp_var))
cwp_var = scm_c_private_lookup ("guile", "current-warning-port");
return scm_call_1 (scm_variable_ref (cwp_var), port);
}
void void
scm_dynwind_current_input_port (SCM port) scm_dynwind_current_input_port (SCM port)
#define FUNC_NAME NULL #define FUNC_NAME NULL

2
libguile/ports.h
View file

@ -247,10 +247,12 @@ SCM_API SCM scm_drain_input (SCM port);
SCM_API SCM scm_current_input_port (void); SCM_API SCM scm_current_input_port (void);
SCM_API SCM scm_current_output_port (void); SCM_API SCM scm_current_output_port (void);
SCM_API SCM scm_current_error_port (void); SCM_API SCM scm_current_error_port (void);
SCM_API SCM scm_current_warning_port (void);
SCM_API SCM scm_current_load_port (void); SCM_API SCM scm_current_load_port (void);
SCM_API SCM scm_set_current_input_port (SCM port); SCM_API SCM scm_set_current_input_port (SCM port);
SCM_API SCM scm_set_current_output_port (SCM port); SCM_API SCM scm_set_current_output_port (SCM port);
SCM_API SCM scm_set_current_error_port (SCM port); SCM_API SCM scm_set_current_error_port (SCM port);
SCM_API SCM scm_set_current_warning_port (SCM port);
SCM_API void scm_dynwind_current_input_port (SCM port); SCM_API void scm_dynwind_current_input_port (SCM port);
SCM_API void scm_dynwind_current_output_port (SCM port); SCM_API void scm_dynwind_current_output_port (SCM port);
SCM_API void scm_dynwind_current_error_port (SCM port); SCM_API void scm_dynwind_current_error_port (SCM port);

15
module/ice-9/boot-9.scm
View file

@ -213,6 +213,8 @@ If there is no handler at all, Guile prints an error and then exits."
(define pk peek) (define pk peek)
;; Temporary definition; replaced later.
(define current-warning-port current-error-port)
(define (warn . stuff) (define (warn . stuff)
(with-output-to-port (current-error-port) (with-output-to-port (current-error-port)
@ -2906,6 +2908,19 @@ module '(ice-9 q) '(make-q q-length))}."
...) ...)
body body* ...))))))) body body* ...)))))))
;;;
;;; Warnings.
;;;
(define current-warning-port
(make-parameter (current-error-port)
(lambda (x)
(if (output-port? x)
x
(error "expected an output port" x)))))
;;; {Running Repls} ;;; {Running Repls}