Common Lisp 如何实现stdout输出的实时捕获而非运行结束后获取

问题原因 #

你当前使用的make-string-output-stream默认是全缓冲模式，只有当流被关闭、缓冲区满或者显式调用force-output/finish-output刷新接口时，才会把写入的内容导出，因此只能等目标函数运行完才能拿到全部输出。

可行实现方案 #

这里提供两种生产环境常用的实现方式，思路和Swank的stdout hook逻辑一致：

方案1：自定义Gray流实现无延迟实时捕获（推荐）

Gray流是绝大多数Common Lisp实现（SBCL、CCL、CLISP等）都支持的标准流扩展接口，我们可以自定义一个带回调的输出流，每次收到写入内容时直接触发处理逻辑，完全不需要等待缓冲区刷新，是Swank内部实现事件化输出的核心方案。

;; 引入Gray流依赖，主流实现均内置支持无需额外安装
#+(or sbcl ccl)
(require :gray-streams)

;; 定义带回调的自定义输出流类
(defclass callback-output-stream (gray-streams:fundamental-character-output-stream)
  ((callback :initarg :callback
             :reader callback-of
             :documentation "输出写入时触发的回调函数，入参为写入的字符串内容")))

;; 实现逐字符写入逻辑
(defmethod gray-streams:stream-write-char ((stream callback-output-stream) char)
  (funcall (callback-of stream) (string char))
  char)

;; 实现批量字符串写入逻辑，提升大输出场景的性能
(defmethod gray-streams:stream-write-sequence ((stream callback-output-stream) seq start end &key &allow-other-keys)
  (funcall (callback-of stream) (subseq seq start end))
  seq)

;; 实现换行逻辑
(defmethod gray-streams:stream-terpri ((stream callback-output-stream))
  (funcall (callback-of stream) (string #\Newline))
  #\Newline)

;; 测试用的目标函数和你原有逻辑完全一致
(defun foo ()
  (loop :for i :from 1 :to 3 :do
    (format t "~A~%" i)
    (sleep 1)))

;; 调用示例
(let* (;; 这里写你的自定义输出处理逻辑，比如存入队列、转发到其他终端等
       (output-handler (lambda (str) (format t "实时捕获到输出：~a" str)))
       (custom-stream (make-instance 'callback-output-stream :callback output-handler))
       (*standard-output* custom-stream))
  (foo))

方案2：轮询+强制刷新（轻量化实现）

如果你不想自定义流，可以用多线程轮询的方式实现，不需要了解Gray流的相关知识，适合简单场景使用：

;; 引入跨实现的线程库，也可以直接用对应实现的原生线程接口
(ql:quickload :bordeaux-threads)
(use-package :bordeaux-threads)

(defun foo ()
  (loop :for i :from 1 :to 3 :do
    (format t "~A~%" i)
    (sleep 1)))

(let* ((s (make-string-output-stream))
       (*standard-output* s))
  ;; 子线程运行目标函数
  (make-thread (lambda () (foo)))
  ;; 主线程轮询拉取输出，可调整sleep参数控制延迟
  (loop :repeat 4 :do
    (sleep 0.5)
    (finish-output s)
    (let ((current-output (get-output-stream-string s)))
      (when (plusp (length current-output))
        (format t "实时拿到输出：~a" current-output)))))

该方案的缺点是存在和轮询间隔相等的输出延迟，适合对实时性要求不高的场景。

内容的提问来源于stack exchange，提问作者Rich