[patch] to silence diagnostic compile messages and welcome message (was GUILE_QUIET)
Matt Wette <[email protected]>
| Newsgroups | gmane.lisp.guile.devel |
|---|---|
| Message-ID | <[email protected]> |
The attached three patches provide modifications to Guile to provide users the ability to silence compile and loading messages that occur when using Guile interactively. In addition, there is a separate capability added to allow users to silence the welcome message. The first is performed by using the `-I' command line argument, or setting the (new) current-info-port to a void-port: > (current-info-port (%make-void-port "w")) The second is performed by, for example, adding the following code to the ~/.guile file: ((@ (system repl repl) %inhibit-welcome-message) #t) The three patches are 0001) fix a minor typo in load.c, associated with the procedure set-current-output-port 0002) make changes to add and use current-info-port, and the associated `-I' command arg 0003) make changes to add and implement the %inhibit-welcome-message parameter. Please consider for merge into the main branch. Many thanks to Arne Babenhauserhiede for engaging discussions on this subject. Thanks, Matt
0003-Create-procedure-to-enable-silencing-the-Guile-welco.patch
(text/x-patch, 1.7 KB)
From 3606c098308cabb6b993c22f84bf20585823dc26 Mon Sep 17 00:00:00 2001 From: Matthew Wette <[email protected]> Date: Mon, 7 Oct 2024 17:28:27 -0700 Subject: [PATCH 3/3] Create procedure to enable silencing the Guile welcome message. * module/system/repl/repl.scm: add parameter `%inhibit-welcome-message' * module/system/repl/repl.scm(run-repl*): add condition for calling procedure repl-welcome: if (%inhibit-welcome-message) is `#t', don't --- module/system/repl/repl.scm | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm index d83d28759..fc525b547 100644 --- a/module/system/repl/repl.scm +++ b/module/system/repl/repl.scm @@ -26,7 +26,7 @@ #:use-module (system repl common) #:use-module (system repl command) #:use-module (ice-9 control) - #:export (start-repl run-repl)) + #:export (start-repl run-repl %inhibit-welcome-message)) ;;; @@ -127,6 +127,11 @@ ;;; The repl ;;; +;; Provide a hook for users to inhibit the welcome message. +;; For example, .guile might include +;; ((@ (system repl repl) %inhibit-welcome-message) #f) +(define %inhibit-welcome-message (make-parameter #f)) + (define* (start-repl #:optional (lang (current-language)) #:key debug) (start-repl* lang debug prompting-meta-read)) @@ -158,7 +163,8 @@ (% (with-fluids ((*repl-stack* (cons repl (or (fluid-ref *repl-stack*) '())))) - (if (null? (cdr (fluid-ref *repl-stack*))) + (if (and (null? (cdr (fluid-ref *repl-stack*))) + (not (%inhibit-welcome-message))) (repl-welcome repl)) (let prompt-loop () (let ((exp (prompting-meta-read repl))) -- 2.43.0
0002-Redirect-diagnostice-output-messages-e.g.-auto-compi.patch
(text/x-patch, 14.2 KB)
From 10343b51d65f357bfc4caf724d19b35cc37fefce Mon Sep 17 00:00:00 2001 From: Matthew Wette <[email protected]> Date: Mon, 7 Oct 2024 17:12:43 -0700 Subject: [PATCH 2/3] Redirect diagnostice output messages (e.g., auto-compiling code) to a newly defined current-info-port, and add a command line argument `-I' to set the current-info-port to a void-port. * libguile/ports.c: add cur_infoport_fluid, scm_current_info_port, scm_set_current_info_port; define default current-info-port to stderr * libguile/load.c(compiled_is_fresh,load_thunk_from_path, do_try_auto_compile,scm_sys_warn_auto_compilation_enabled, scm_primitive_load_path): direct output messages to current_info_port; was current_warning_port * libguile/init.c(scm_init_standard_ports): set default current_info_port * module/ice-9/ports.scm: define current-info-port and set-current-info-port * module/ice-9/command-line.scm(*usage*,compile-shell-switches): add argument `-I' to silence diagnostics (or current-info-port to void-port) * doc/ref/guile-invoke.texi: add description for `-I' command argument --- doc/ref/guile-invoke.texi | 4 ++++ libguile/init.c | 1 + libguile/load.c | 42 +++++++++++++++++------------------ libguile/ports.c | 31 ++++++++++++++++++++++++++ libguile/ports.h | 2 ++ module/ice-9/boot-9.scm | 13 ++++++++--- module/ice-9/command-line.scm | 4 ++++ module/ice-9/ports.scm | 18 ++++++++++++--- 8 files changed, 88 insertions(+), 27 deletions(-) diff --git a/doc/ref/guile-invoke.texi b/doc/ref/guile-invoke.texi index 856bce7b8..7ceef0bb5 100644 --- a/doc/ref/guile-invoke.texi +++ b/doc/ref/guile-invoke.texi @@ -171,6 +171,10 @@ detailed backtrace upon error. The only difference with @option{--debug} is lack of support for VM hooks and the facilities that build upon it (see above). +@item -I +Do not report diagnostic messages (e.g., from compiling source files). +This sets @code{current-info-port} to a void-port. + @item -q @cindex init file, not loading @cindex @file{.guile} file, not loading diff --git a/libguile/init.c b/libguile/init.c index 4a3903a2c..3df8c5ae5 100644 --- a/libguile/init.c +++ b/libguile/init.c @@ -200,6 +200,7 @@ scm_init_standard_ports () scm_set_current_error_port (scm_standard_stream_to_port (2, isatty (2) ? "w0" : "w")); scm_set_current_warning_port (scm_current_error_port ()); + scm_set_current_info_port (scm_current_error_port ()); } diff --git a/libguile/load.c b/libguile/load.c index 34e7934b9..35613077b 100644 --- a/libguile/load.c +++ b/libguile/load.c @@ -571,11 +571,11 @@ compiled_is_fresh (SCM full_filename, SCM compiled_filename, else { compiled_is_newer = 0; - scm_puts (";;; note: source file ", scm_current_warning_port ()); - scm_display (full_filename, scm_current_warning_port ()); - scm_puts ("\n;;; newer than compiled ", scm_current_warning_port ()); - scm_display (compiled_filename, scm_current_warning_port ()); - scm_puts ("\n", scm_current_warning_port ()); + scm_puts (";;; note: source file ", scm_current_info_port ()); + scm_display (full_filename, scm_current_info_port ()); + scm_puts ("\n;;; newer than compiled ", scm_current_info_port ()); + scm_display (compiled_filename, scm_current_info_port ()); + scm_puts ("\n", scm_current_info_port ()); } return compiled_is_newer; @@ -770,9 +770,9 @@ load_thunk_from_path (SCM filename, SCM source_file_name, if (found_stale_file && *found_stale_file) { scm_puts (";;; found fresh compiled file at ", - scm_current_warning_port ()); - scm_display (found, scm_current_warning_port ()); - scm_newline (scm_current_warning_port ()); + scm_current_info_port ()); + scm_display (found, scm_current_info_port ()); + scm_newline (scm_current_info_port ()); } goto end; @@ -1017,9 +1017,9 @@ do_try_auto_compile (void *data) SCM source = SCM_PACK_POINTER (data); SCM comp_mod, compile_file; - scm_puts (";;; compiling ", scm_current_warning_port ()); - scm_display (source, scm_current_warning_port ()); - scm_newline (scm_current_warning_port ()); + scm_puts (";;; compiling ", scm_current_info_port ()); + scm_display (source, scm_current_info_port ()); + scm_newline (scm_current_info_port ()); comp_mod = scm_c_resolve_module ("system base compile"); compile_file = scm_module_variable (comp_mod, sym_compile_file); @@ -1046,17 +1046,17 @@ do_try_auto_compile (void *data) /* Assume `*current-warning-prefix*' has an appropriate value. */ res = scm_call_n (scm_variable_ref (compile_file), args, 5); - scm_puts (";;; compiled ", scm_current_warning_port ()); - scm_display (res, scm_current_warning_port ()); - scm_newline (scm_current_warning_port ()); + scm_puts (";;; compiled ", scm_current_info_port ()); + scm_display (res, scm_current_info_port ()); + scm_newline (scm_current_info_port ()); return res; } else { - scm_puts (";;; it seems ", scm_current_warning_port ()); - scm_display (source, scm_current_warning_port ()); + scm_puts (";;; it seems ", scm_current_info_port ()); + scm_display (source, scm_current_info_port ()); scm_puts ("\n;;; is part of the compiler; skipping auto-compilation\n", - scm_current_warning_port ()); + scm_current_info_port ()); return SCM_BOOL_F; } } @@ -1099,7 +1099,7 @@ SCM_DEFINE (scm_sys_warn_auto_compilation_enabled, "%warn-auto-compilation-enabl { scm_puts (";;; note: auto-compilation is enabled, set GUILE_AUTO_COMPILE=0\n" ";;; or pass the --no-auto-compile argument to disable.\n", - scm_current_warning_port ()); + scm_current_info_port ()); message_shown = 1; } @@ -1232,9 +1232,9 @@ SCM_DEFINE (scm_primitive_load_path, "primitive-load-path", 0, 0, 1, if (found_stale_compiled_file) { scm_puts (";;; found fresh local cache at ", - scm_current_warning_port ()); - scm_display (fallback, scm_current_warning_port ()); - scm_newline (scm_current_warning_port ()); + scm_current_info_port ()); + scm_display (fallback, scm_current_info_port ()); + scm_newline (scm_current_info_port ()); } compiled_thunk = try_load_thunk_from_file (fallback); } diff --git a/libguile/ports.c b/libguile/ports.c index e9919a1e8..764fa9376 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -432,6 +432,7 @@ static SCM cur_inport_fluid = SCM_BOOL_F; static SCM cur_outport_fluid = SCM_BOOL_F; static SCM cur_errport_fluid = SCM_BOOL_F; static SCM cur_warnport_fluid = SCM_BOOL_F; +static SCM cur_infoport_fluid = SCM_BOOL_F; static SCM cur_loadport_fluid = SCM_BOOL_F; SCM_DEFINE (scm_current_input_port, "current-input-port", 0, 0, 0, @@ -488,6 +489,18 @@ SCM_DEFINE (scm_current_warning_port, "current-warning-port", 0, 0, 0, } #undef FUNC_NAME +SCM_DEFINE (scm_current_info_port, "current-info-port", 0, 0, 0, + (void), + "Return the port to which diagnostic information should be sent.") +#define FUNC_NAME s_scm_current_info_port +{ + if (scm_is_true (cur_infoport_fluid)) + return scm_fluid_ref (cur_infoport_fluid); + else + return SCM_BOOL_F; +} +#undef FUNC_NAME + SCM_DEFINE (scm_current_load_port, "current-load-port", 0, 0, 0, (), "Return the current-load-port.\n" @@ -545,6 +558,18 @@ scm_set_current_warning_port (SCM port) } #undef FUNC_NAME +SCM +scm_set_current_info_port (SCM port) +#define FUNC_NAME "set-current-info-port" +{ + SCM oinfop = scm_fluid_ref (cur_infoport_fluid); + port = SCM_COERCE_OUTPORT (port); + SCM_VALIDATE_OPOUTPORT (1, port); + scm_fluid_set_x (cur_infoport_fluid, port); + return oinfop; +} +#undef FUNC_NAME + void scm_dynwind_current_input_port (SCM port) #define FUNC_NAME NULL @@ -4187,6 +4212,7 @@ scm_init_ice_9_ports (void) scm_c_define ("%current-output-port-fluid", cur_outport_fluid); scm_c_define ("%current-error-port-fluid", cur_errport_fluid); scm_c_define ("%current-warning-port-fluid", cur_warnport_fluid); + scm_c_define ("%current-info-port-fluid", cur_infoport_fluid); } void @@ -4221,6 +4247,7 @@ scm_init_ports (void) cur_outport_fluid = scm_make_fluid (); cur_errport_fluid = scm_make_fluid (); cur_warnport_fluid = scm_make_fluid (); + cur_infoport_fluid = scm_make_fluid (); cur_loadport_fluid = scm_make_fluid (); default_port_encoding_var = @@ -4259,4 +4286,8 @@ scm_init_ports (void) (scm_t_subr) scm_current_error_port); scm_c_define_gsubr (s_scm_current_warning_port, 0, 0, 0, (scm_t_subr) scm_current_warning_port); + + /* Used by welcome and compiler routines. */ + scm_c_define_gsubr (s_scm_current_info_port, 0, 0, 0, + (scm_t_subr) scm_current_info_port); } diff --git a/libguile/ports.h b/libguile/ports.h index 44ef29d87..d481c2967 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -139,11 +139,13 @@ 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_info_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 SCM scm_set_current_info_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 627910ad9..04f84215c 100644 --- a/module/ice-9/boot-9.scm +++ b/module/ice-9/boot-9.scm @@ -190,6 +190,13 @@ This is handy for tracing function calls, e.g.: (newline (current-warning-port)) (car (last-pair stuff))) +(define (info . stuff) + (newline (current-info-port)) + (display ";;; INFO " (current-info-port)) + (display stuff (current-info-port)) + (newline (current-info-port)) + (car (last-pair stuff))) + ;;; {Features} @@ -4348,15 +4355,15 @@ when none is available, reading FILE-NAME with READER." (load-thunk-from-file go-file-name) (begin (when gostat - (format (current-warning-port) + (format (current-info-port) ";;; note: source file ~a\n;;; newer than compiled ~a\n" name go-file-name)) (cond (%load-should-auto-compile (%warn-auto-compilation-enabled) - (format (current-warning-port) ";;; compiling ~a\n" name) + (format (current-info-port) ";;; compiling ~a\n" name) (let ((cfn (compile name))) - (format (current-warning-port) ";;; compiled ~a\n" cfn) + (format (current-info-port) ";;; compiled ~a\n" cfn) (load-thunk-from-file cfn))) (else #f))))) #:warning "WARNING: compilation of ~a failed:\n" name)) diff --git a/module/ice-9/command-line.scm b/module/ice-9/command-line.scm index 5133d8d44..32a56ad11 100644 --- a/module/ice-9/command-line.scm +++ b/module/ice-9/command-line.scm @@ -135,6 +135,7 @@ If FILE begins with `-' the -s switch is mandatory. files. --listen[=P] listen on a local port or a path for REPL clients; if P is not given, the default is local port 37146 + -I silence informative diagnostics -q inhibit loading of user init file --use-srfi=LS load SRFI modules for the SRFIs in LS, which is a list of numbers like \"2,13,14\" @@ -382,6 +383,9 @@ If FILE begins with `-' the -s switch is mandatory. (parse args (cons '(install-r7rs!) out))) + ((string=? arg "-I") ; silence diagostics + (parse args (cons `(current-info-port (%make-void-port "w")) out))) + ((string=? arg "--listen") ; start a repl server (parse args (cons '((@@ (system repl server) spawn-server)) out))) diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm index 833429eca..e1a6212eb 100644 --- a/module/ice-9/ports.scm +++ b/module/ice-9/ports.scm @@ -30,10 +30,10 @@ %port-property %set-port-property! current-input-port current-output-port - current-error-port current-warning-port + current-error-port current-warning-port current-info-port current-load-port set-current-input-port set-current-output-port - set-current-error-port + set-current-error-port set-current-info-port port-mode port? input-port? @@ -144,7 +144,8 @@ call-with-output-string close-port current-error-port - current-warning-port)) + current-warning-port + current-info-port)) (load-extension (string-append "libguile-" (effective-version)) "scm_init_ice_9_ports") @@ -290,6 +291,13 @@ interpret its input and output." (error "expected an output port" x)) x))) +(define current-info-port + (fluid->parameter %current-info-port-fluid + (lambda (x) + (unless (output-port? x) + (error "expected an output port" x)) + x))) + @@ -396,6 +404,10 @@ interpret its input and output." "Set the current default error port to @var{port}." (current-error-port port)) +(define (set-current-info-port port) + "Set the current default info port to @var{port}." + (current-info-port port)) + ;;;; high level routines -- 2.43.0
0001-Fix-typo-in-naming-function-set-current-output-port.patch
(text/x-patch, 827 B)
From 7d17963ed8542427e30959481c88b8e528ee7399 Mon Sep 17 00:00:00 2001 From: Matthew Wette <[email protected]> Date: Mon, 7 Oct 2024 17:06:23 -0700 Subject: [PATCH 1/3] Fix typo in naming function set-current-output-port * libguile/ports.c(scm_set_current_output_port): scheme name is set-current-output-port --- libguile/ports.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/libguile/ports.c b/libguile/ports.c index d0e4e0c7f..e9919a1e8 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -511,7 +511,7 @@ scm_set_current_input_port (SCM port) SCM scm_set_current_output_port (SCM port) -#define FUNC_NAME "scm-set-current-output-port" +#define FUNC_NAME "set-current-output-port" { SCM ooutp = scm_fluid_ref (cur_outport_fluid); port = SCM_COERCE_OUTPORT (port); -- 2.43.0