0.8.5.29:
[sbcl.git] / contrib / sb-aclrepl / repl.lisp
index f5830db..0b16d89 100644 (file)
 
 (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*"
 (defun process-history-search (pattern cmd-args-string)
   (let ((cmd (find-history-matching-pattern pattern)))
     (unless cmd
-      (format *output* "No match on history list with pattern ~S" pattern)
+      (format *output* "No match on history list with pattern ~S~%" pattern)
       (return-from process-history-search *null-cmd*))
     (maybe-return-history-cmd cmd cmd-args-string)))
 
 
 (defun apropos-cmd (string)
   (apropos (string-upcase string))
+  (fresh-line *output*)
   (values))
 
 (let ((last-files-loaded nil))
 
 (defun pushd-cmd (string-arg)
   (push string-arg *dir-stack*)
-  (cd-cmd *output* string-arg)
+  (cd-cmd string-arg)
   (values))
 
 (defun popd-cmd ()
       (let ((stopped-threads (sb-thread::waitqueue-data lock)))
        (when stopped-threads
          (format stream "~{~&Thread ~A suspended~}~%" stopped-threads))))
+    (fresh-line stream)
     (if (functionp *prompt*)
        (write-string (funcall *prompt*
                               break-level