Subject: bug#13077: guile: add repl-option for customized print

From: Daniel Hartwig <[email-masked]>
Date: Tue, 04 Dec 2012 11:46:53 +0800

Package: guile
Severity: wishlist
Tags: patch
X-Debbugs-CC: nalaginrut <[email-masked]>

Dear maintainer

The attached patch adds a new repl-option to set a custom print
procedure.

--
scheme@(guile-user)> (use-modules (srfi srfi-1))
scheme@(guile-user)> (iota 20)
$1 = (0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19)
scheme@(guile-user)> (define (repl-print* repl val)
                       (if (not (eq? val *unspecified*))
                           (begin
                             (run-hook before-print-hook val)
                             (format #t "~20@y" val)
                             (newline))))
scheme@(guile-user)> (use-modules (system repl common))
scheme@(guile-user)> (repl-option-set! (car (fluid-ref *repl-stack*)) 'print repl-print*)
scheme@(guile-user)> (iota 20)
$2 = (0 1 2 3 4 5 6 7 …)
>From b0cadcb69a12a4ed2a205f4854af41bf926da20b Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <[email-masked]>
Date: Tue, 4 Dec 2012 11:41:35 +0800
Subject: [PATCH] repl: add repl-option for customized print

* module/system/repl/common.scm (repl-default-options)
  (repl-print): Add option to use customized print procedure.
* doc/ref/scheme-using.texi (REPL Commands): Update.
---
 doc/ref/scheme-using.texi     |    4 ++++
 module/system/repl/common.scm |   26 +++++++++++++++++---------
 2 files changed, 21 insertions(+), 9 deletions(-)

diff --git a/doc/ref/scheme-using.texi b/doc/ref/scheme-using.texi
index 7eb84de..4f9e6db 100644
--- a/doc/ref/scheme-using.texi
+++ b/doc/ref/scheme-using.texi
@@ -445,6 +445,10 @@ choice is available.  Off by default (indicating compilation).
 @item prompt
 A customized REPL prompt.  @code{#f} by default, indicating the default
 prompt.
+@item print
+A procedure of two arguments used to print the result of evaluating each
+expression.  The arguments are the current REPL and the value to print.
+By default, @code{#f}, to use the default procedure.
 @item value-history
 Whether value history is on or not.  @xref{Value History}.
 @item on-error
diff --git a/module/system/repl/common.scm b/module/system/repl/common.scm
index 346ba99..fd41b09 100644
--- a/module/system/repl/common.scm
+++ b/module/system/repl/common.scm
@@ -119,6 +119,11 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
                     ((thunk? prompt) (lambda (repl) (prompt)))
                     ((procedure? prompt) prompt)
                     (else (error "Invalid prompt" prompt)))))
+     (print #f ,(lambda (print)
+                  (cond
+                   ((not print) #f)
+                   ((procedure? print) print)
+                   (else (error "Invalid print procedure" print)))))
      (value-history
       ,(value-history-enabled?)
       ,(lambda (x)
@@ -206,15 +211,18 @@ See <http://www.gnu.org/licenses/lgpl.html>, for more details.")
     (% (thunk))))
 
 (define (repl-print repl val)
-  (if (not (eq? val *unspecified*))
-      (begin
-        (run-hook before-print-hook val)
-        ;; The result of an evaluation is representable in scheme, and
-        ;; should be printed with the generic printer, `write'. The
-        ;; language-printer is something else: it prints expressions of
-        ;; a given language, not the result of evaluation.
-	(write val)
-	(newline))))
+  (cond
+   ((repl-option-ref repl 'print)
+    => (lambda (print) (print repl val)))
+   ((not (eq? val *unspecified*))
+    (begin
+      (run-hook before-print-hook val)
+      ;; The result of an evaluation is representable in scheme, and
+      ;; should be printed with the generic printer, `write'. The
+      ;; language-printer is something else: it prints expressions of
+      ;; a given language, not the result of evaluation.
+      (write val)
+      (newline)))))
 
 (define (repl-option-ref repl key)
   (cadr (or (assq key (repl-options repl))
-- 
1.7.10.4