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, to...@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)))
+
;;; {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))
