Re: GUILE_QUIET=1 guile → suppress REPL wel come message (fixed message format)

Matt Wette <[email protected]>
Newsgroups gmane.lisp.guile.devel
Message-ID <[email protected]>
On 10/2/24 2:56 PM, Matt Wette wrote:
> On 10/2/24 12:13 PM, Dr. Arne Babenhauserheide wrote:
>> Hi Matt,
>>
>> I just ran the testsuite after applying your changes, and it stalls at
>>
>> $ make check -j16
>> ...
>> ;;; SSAX warning: DOCTYPE DECL T system1 found and skipped
>> UNRESOLVED: time.test: strftime: C99 %z format: strftime fr_FR.iso88591
>> UNRESOLVED: time.test: strptime: GNU %s format: strftime fr_FR.iso88591
>>
>> Can you investigate whether this needs changes to tests or causes regressions?
> Will do.
>

Hi Arne,

I got it working.   I made two changes:
1) I updated the change to ice-9/command-line.scm.  The `patch' command 
rejected the
     location of the `-I' option placement.
2) I reverted the change to system/repl/common.scm which had changed the 
output of the
     welcome message from default output port to info-port.   This was 
causing the repl-server
    test to fail.   If a user uses Guile as a extension, and does not 
want the default Guile welcome
    message, they can generate their own repl.

I hope this is satisfactory.  If not, let me know.

Matt

    something custom
0002-system-repl-common.scm-repl-welcome-revert-use-of-in.patch (text/x-patch, 982 B)
From 0788066a270a77359ca3aebb97d4ab20039aa071 Mon Sep 17 00:00:00 2001
From: Matthew Wette <[email protected]>
Date: Fri, 4 Oct 2024 13:32:54 -0700
Subject: [PATCH 2/2] system/repl/common.scm(repl-welcome): revert use of
 info-port

---
 module/system/repl/common.scm | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index b7276f319..a3f2032ba 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -160,10 +160,10 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
               #:debug debug))
 
 (define (repl-welcome repl)
-  (display *version* (current-info-port))
-  (newline (current-info-port))
-  (newline (current-info-port))
-  (display "Enter `,help' for help.\n" (current-info-port)))
+  (display *version*)
+  (newline)
+  (newline)
+  (display "Enter `,help' for help.\n"))
 
 (define (repl-prompt repl)
   (cond
-- 
2.43.0
0001-close-to-orig-patch.patch (text/x-patch, 13.7 KB)
From 66bc20c90f6e4ae1ad19c969fc234b6038224c4c Mon Sep 17 00:00:00 2001
From: Matthew Wette <[email protected]>
Date: Fri, 4 Oct 2024 07:48:36 -0700
Subject: [PATCH 1/2] close to orig patch

---
 libguile/init.c               |  1 +
 libguile/load.c               | 42 +++++++++++++++++------------------
 libguile/ports.c              | 33 ++++++++++++++++++++++++++-
 libguile/ports.h              |  2 ++
 module/ice-9/boot-9.scm       | 13 ++++++++---
 module/ice-9/command-line.scm |  5 +++++
 module/ice-9/ports.scm        | 18 ++++++++++++---
 module/system/repl/common.scm |  8 +++----
 8 files changed, 90 insertions(+), 32 deletions(-)

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 d0e4e0c7f..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"
@@ -511,7 +524,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);
@@ -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..1e6149fcc 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,10 @@ 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
 
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index a3f2032ba..b7276f319 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -160,10 +160,10 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
               #:debug debug))
 
 (define (repl-welcome repl)
-  (display *version*)
-  (newline)
-  (newline)
-  (display "Enter `,help' for help.\n"))
+  (display *version* (current-info-port))
+  (newline (current-info-port))
+  (newline (current-info-port))
+  (display "Enter `,help' for help.\n" (current-info-port)))
 
 (define (repl-prompt repl)
   (cond
-- 
2.43.0
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.