From 4e7092a3248d55e4af0b45c38a67e3a7998b59a7 Mon Sep 17 00:00:00 2001
From: Mark Wooding <mdw@distorted.org.uk>
Date: Wed, 1 Jul 2020 19:39:01 +0100
Subject: [PATCH] dot/lisp-init.lisp, dot/shell-rc: Suppress Lisp heralds; use
 `rlwrap'.

Add shell aliases -- and, in one case, some awful Lisp-level hacking --
to suppress Lisp system heralds.

The hacking for ECL is unusually terrible, because it breaks
`*standard-output*' until the prompt is ready to appear, so inhibit it
if there are any command-line arguments which might, for example, want
to print something.
---
 dot/lisp-init.lisp | 18 ++++++++++++++++++
 dot/shell-rc       |  6 ++++++
 2 files changed, 24 insertions(+)

diff --git a/dot/lisp-init.lisp b/dot/lisp-init.lisp
index da50a6f..8b0e3f9 100644
--- a/dot/lisp-init.lisp
+++ b/dot/lisp-init.lisp
@@ -13,6 +13,24 @@
 (setf ext:*gc-verbose* nil
       ext:*require-verbose* nil)
 
+#+ecl
+(let ((old-output *standard-output*)
+      (old-prompt si:*tpl-prompt-hook*))
+  ;; There doesn't seem to be a good way to do this, so we do it the bad
+  ;; way.  Since the herald is printed to `*standard-outout*', we set (not
+  ;; bind!) that to a bit bucket, and then arrange to restore it just before
+  ;; the first REPL prompt is written.
+  ;;
+  ;; One more awful part is that, having intercepted the prompt hook, I need
+  ;; to restore and invoke the old version, and there isn't a clean way to do
+  ;; this.
+  (when (<= (ext:argc) 1)
+    (setf *standard-output* (make-broadcast-stream)
+	  si:*tpl-prompt-hook* (lambda ()
+				 (setf *standard-output* old-output
+				       si:*tpl-prompt-hook* old-prompt)
+				 (si::tpl-prompt)))))
+
 ;; Obtain ASDF from somewhere.
 (require "asdf")
 
diff --git a/dot/shell-rc b/dot/shell-rc
index 7313cee..ea4f575 100644
--- a/dot/shell-rc
+++ b/dot/shell-rc
@@ -221,6 +221,12 @@ alias make="nice make"
 alias cross-run="nice cross-run"
 alias gdb="gdb -q"
 
+## Shut up Lisp interpreters.
+alias clisp="clisp -q -q"
+alias cmucl="rlwrap cmucl -quiet"
+alias ecl="rlwrap ecl"
+alias sbcl="rlwrap sbcl --noinform"
+
 ###--------------------------------------------------------------------------
 ### Colour output.
 
-- 
2.11.0