Re: Quiet compilation for scripting

[Matt Wette <matt.wette@gmail.com>]

On 3/15/24 1:52 PM, Matt Wette wrote:
> On 3/15/24 1:47 PM, Marc Chantreux wrote:
>> On Fri, Mar 15, 2024 at 08:00:09PM +0100, tomas@tuxteam.de wrote:
>>>> I think most of Guile user actually want this feature for a long time.
>>>> I can understand.
>>> I agree.
>> so do I.
>
> As mentioned on another topic (start=up message) I had once hacked 
> guile to have a
> info-port, with initial welcome message and compile messages going to 
> (current-info-port).
> Adding a command arg to set that to a file or /dev/null would fix both 
> issues.
>
> Matt
>
>
I think is it.

--- libguile/ports.c-orig	2023-05-29 06:18:05.866508234 -0700
+++ libguile/ports.c	2023-05-29 09:00:54.592316332 -0700
@@ -432,6 +432,7 @@
  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 @@
  }
  #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 @@
  }
  #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
@@ -4155,6 +4180,7 @@
    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
@@ -4189,6 +4215,7 @@
    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 =
@@ -4227,4 +4254,8 @@
                        (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);
  }
--- module/ice-9/command-line.scm-orig	2023-05-29 09:45:37.186157673 -0700
+++ module/ice-9/command-line.scm	2023-05-29 10:36:29.730463604 -0700
@@ -135,6 +135,7 @@
                   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
+  --info-file=PORT  set output file for 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\"
@@ -142,6 +143,7 @@
                   R6RS
    --r7rs         change initial Guile environment to better support
                   R7RS
+  -W             don't print welcome message
    -h, --help     display this help and exit
    -v, --version  display version information and exit
    \\              read arguments from following script lines"))
@@ -386,6 +388,14 @@
              (parse args
                     (cons '((@@ (system repl server) spawn-server)) out)))
             
+           ((string=? arg "--info-file")   ; set info port
+            (parse args
+                   (cons `(set-current-info-port
+                           ',(open-file
+                              (substring arg (string-length "--info-port="))
+                              "w"))
+                         out)))
+
             ((string-prefix? "--listen=" arg) ; start a repl server
              (parse
               args
@@ -405,6 +415,12 @@
                    (error "unknown argument to --listen"))))
                out)))
  
+           #|
+           ((string=? "-W" arg)
+            (parse args
+                   (cons '(skip-welcome) out)))
+           |#
+
             ((or (string=? arg "-h") (string=? arg "--help"))
              (shell-usage usage-name #f)
              (exit 0))
--- module/ice-9/boot-9.scm-orig	2023-05-29 10:40:16.405710774 -0700
+++ module/ice-9/boot-9.scm	2023-05-29 09:26:41.743249629 -0700
@@ -190,6 +190,13 @@
    (newline (current-warning-port))
    (car (last-pair stuff)))
  
+(define (info . stuff)
+  (newline (current-info-port))
+  (display ";;; FYI " (current-info-port))
+  (display stuff (current-info-port))
+  (newline (current-info-port))
+  (car (last-pair stuff)))
+
  \f
  
  ;;; {Features}
@@ -4328,15 +4335,15 @@
             (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))