From 805a1813420c480559c849bc1984f65db3880937 Mon Sep 17 00:00:00 2001
From: Noah Lavine <nlavine@haverford.edu>
Date: Sun, 13 Feb 2011 16:17:11 -0500
Subject: [PATCH] Show prompts after a comment in the REPL

 * module/system/repl/repl.scm (next-char, run-repl, meta-reader): if the
    current language is Scheme, ignore any characters from a semicolon to
    the end of the line, then print a new prompt.
---
 module/system/repl/repl.scm |   29 +++++++++++++++++++++--------
 1 files changed, 21 insertions(+), 8 deletions(-)

diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index b135dbb..47e5771 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -29,6 +29,7 @@
   #:use-module (system repl common)
   #:use-module (system repl command)
   #:use-module (ice-9 control)
+  #:use-module (ice-9 rdelim)
   #:export (start-repl run-repl))
 
 
@@ -62,11 +63,11 @@
 
 (define meta-command-token (cons 'meta 'command))
 
-(define (meta-reader read env)
+(define (meta-reader read env semicolon-comments)
   (lambda* (#:optional (port (current-input-port)))
     (with-input-from-port port
       (lambda ()
-        (let ((ch (next-char #t)))
+        (let ((ch (next-char #t semicolon-comments)))
           (cond ((eof-object? ch)
                  ;; EOF objects are not buffered. It's quite possible
                  ;; to peek an EOF then read something else. It's
@@ -75,6 +76,7 @@
                 ((eqv? ch #\,)
                  (read-char port)
                  meta-command-token)
+                ((not ch) *unspecified*)
                 (else (read port env))))))))
         
 ;; repl-reader is a function defined in boot-9.scm, and is replaced by
@@ -82,12 +84,13 @@
 ;; to be able to re-use the existing readline machinery.
 ;;
 ;; Catches read errors, returning *unspecified* in that case.
-(define (prompting-meta-read repl)
+(define (prompting-meta-read repl semicolon-comments)
   (catch #t
     (lambda ()
       (repl-reader (lambda () (repl-prompt repl))
                    (meta-reader (language-reader (repl-language repl))
-                                (current-module))))
+                                (current-module)
+                                semicolon-comments)))
     (lambda (key . args)
       (case key
         ((quit)
@@ -146,7 +149,10 @@
        (if (null? (cdr (fluid-ref *repl-stack*)))
            (repl-welcome repl))
        (let prompt-loop ()
-         (let ((exp (prompting-meta-read repl)))
+         (let ((exp (prompting-meta-read
+                     repl
+                     (eq? (repl-language (car (fluid-ref *repl-stack*)))
+                          scheme-lang))))
            (cond
             ((eqv? exp *unspecified*))  ; read error, pass
             ((eq? exp meta-command-token)
@@ -197,16 +203,23 @@
                   (lambda (k . args)
                     (abort args))))
               #:trap-handler 'disabled)))
-           (next-char #f) ;; consume trailing whitespace
+           (next-char #f (eq? (repl-language (car (fluid-ref *repl-stack*)))
+                              scheme-lang)) ;; consume trailing whitespace
            (prompt-loop))))
      (lambda (k status)
        status)))
 
-(define (next-char wait)
+(define scheme-lang (lookup-language 'scheme))
+
+(define (next-char wait semicolon-comments)
   (if (or wait (char-ready?))
       (let ((ch (peek-char)))
 	(cond ((eof-object? ch) ch)
-	      ((char-whitespace? ch) (read-char) (next-char wait))
+              ((and (char=? ch #\;) semicolon-comments)
+               (read-line) #f) ; ignore wait after a newline
+	      ((char-whitespace? ch)
+               (read-char)
+               (next-char wait semicolon-comments))
 	      (else ch)))
       #f))
 
-- 
1.7.4