diff options
| -rw-r--r-- | libguile/ports.c | 24 | ||||
| -rw-r--r-- | libguile/ports.h | 2 | ||||
| -rw-r--r-- | module/ice-9/boot-9.scm | 15 |
3 files changed, 41 insertions, 0 deletions
diff --git a/libguile/ports.c b/libguile/ports.c index 6467228c0..677b2789a 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -412,6 +412,17 @@ SCM_DEFINE (scm_current_error_port, "current-error-port", 0, 0, 0, } #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, (), "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 + +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 scm_dynwind_current_input_port (SCM port) #define FUNC_NAME NULL diff --git a/libguile/ports.h b/libguile/ports.h index 6a669b660..fcf1424cc 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -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_output_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_set_current_input_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_warning_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_error_port (SCM port); diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm index 47f0ead60..1d25f63df 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -213,6 +213,8 @@ If there is no handler at all, Guile prints an error and then exits." (define pk peek) +;; Temporary definition; replaced later. +(define current-warning-port current-error-port) (define (warn . stuff) (with-output-to-port (current-error-port) @@ -2907,6 +2909,19 @@ module '(ice-9 q) '(make-q q-length))}." 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} ;;; |