[Sbcl-commits] CVS: sbcl/contrib/sb-aclrepl inspect.lisp,1.19,1.20 repl.lisp,1.18,1.19

[Kevin R. <kev...@us...>]

Update of /cvsroot/sbcl/sbcl/contrib/sb-aclrepl
In directory sc8-pr-cvs1:/tmp/cvs-serv29225/contrib/sb-aclrepl

Modified Files:
	inspect.lisp repl.lisp 
Log Message:
0.8.3.40:
   * Apply Nikodemus's patch for cl-linedit
   * Minor changes to inspect.lisp


Index: inspect.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-aclrepl/inspect.lisp,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -d -r1.19 -r1.20
--- inspect.lisp	9 Jun 2003 17:05:53 -0000	1.19
+++ inspect.lisp	7 Sep 2003 05:21:59 -0000	1.20
@@ -1,4 +1,4 @@
-/nick;;;; Inspector for sb-aclrepl
+;;;; Inspector for sb-aclrepl
 ;;;;
 ;;;; The documentation, which may or may not apply in its entirety at
 ;;;; any given time, for this functionality is on the ACL website:
@@ -599,7 +599,7 @@
 cons cells and LIST-TYPE is :normal, :dotted, or :cyclic"
     (do ((length 1 (1+ length))
 	 (lst (cdr object) (cdr lst)))
-	((or (not(consp lst))
+	((or (not (consp lst))
 	     (eq object lst))
 	 (cond
 	   ((null lst)
@@ -615,10 +615,9 @@
   (multiple-value-bind (length list-type) (cons-safe-length object)
     (format nil "a ~A list with ~D element~:*~P~A"
 	    (string-downcase (symbol-name list-type)) length
-	    (case list-type
+	    (ecase list-type
 	      ((:dotted :cyclic) "+tail")
-	      (t "")))))
-
+	      (:normal "")))))
 
 (defun ref32-hexstr (obj &optional (offset 0))
   (format nil "~8,'0X" (ref32 obj offset)))

Index: repl.lisp
===================================================================
RCS file: /cvsroot/sbcl/sbcl/contrib/sb-aclrepl/repl.lisp,v
retrieving revision 1.18
retrieving revision 1.19
diff -u -d -r1.18 -r1.19
--- repl.lisp	18 Aug 2003 07:53:35 -0000	1.18
+++ repl.lisp	7 Sep 2003 05:21:59 -0000	1.19
@@ -86,21 +86,24 @@
 
 (defun read-cmd (input-stream)
   ;; Reads a command from the user and returns a user-cmd object
-  (let ((next-char (peek-char-non-whitespace input-stream)))
-    (cond
-      ((eql *command-char* next-char)
-       (dispatch-command-line input-stream))
-      ((eql #\newline next-char)
-       (read-char input-stream)
-       *null-cmd*)
-      ((eql :eof next-char)
-       *eof-cmd*)
-      (t
-       (let* ((eof (cons nil *eof-marker*))
-	      (form (read input-stream nil eof)))
-	 (if (eq form eof)
-	     *eof-cmd*
-	     (make-user-cmd :input form :func nil :hnum *cmd-number*)))))))
+  (let* ((next-char (peek-char-non-whitespace input-stream))
+	 (cmd (cond
+		((eql *command-char* next-char)
+		 (dispatch-command-line input-stream))
+		((eql #\newline next-char)
+		 (read-char input-stream)
+		 *null-cmd*)
+		((eql :eof next-char)
+		 *eof-cmd*)
+		(t
+		 (let* ((eof (cons nil *eof-marker*))
+			(form (read input-stream nil eof)))
+		   (if (eq form eof)
+		       *eof-cmd*
+		       (make-user-cmd :input form :func nil :hnum *cmd-number*)))))))
+    (if (and (eq cmd *eof-cmd*) (typep input-stream 'string-stream))
+	(throw 'repl-catcher cmd)
+	cmd)))
 
 (defun dispatch-command-line (input-stream)
   "Processes an input line that starts with *command-char*"