Stability fixes in sly-mrepl

* contrib/sly-mrepl.el: Fix top doc.
(sly-mrepl): Don't list license and authord in contrib def.
(sly-mrepl--prompt): `accept-process-output' here.
(:write-values): Not here.
(:evaluation-aborted): Print condition.

* contrib/swank-mrepl.lisp (listener-channel): Remove DEDICATED slot, add
IN and OUT.
(initialize-instance): Make IN and OUT here, possibly blocking
while waiting for Emacs to connect to OUT.
(create-mrepl): Don't open DEDICATED here.
(mrepl-eval): Use HANDLER-CASE to catch errors. Always flush
streams.
(flush-streams): New function.
(send-prompt): Just send prompt.

contrib/sly-mrepl.el

-;; -*- lexical-binding: t -*-
-;; An experimental implementation of multiple REPLs multiplexed over a
-;; single Slime socket.  M-x sly-open-listener creates a new REPL
-;; buffer.
+;; -*- lexical-binding: t -*- An experimental implementation of
+;; multiple REPLs multiplexed over a single Slime socket.  M-x
+;; sly-mrepl or M-x sly-mrepl-new create new REPL buffers.
 ;;
 (require 'sly)
 (require 'inferior-sly) ; inferior-sly-indent-lime
@@ -9,8 +8,6 @@
 
 (define-sly-contrib sly-mrepl
   "Multiple REPLs."
-  (:authors "Helmut Eller <heller@common-lisp.net>")
-  (:license "GPL")
   (:swank-dependencies swank-mrepl)
   (:on-load
    (define-key sly-inspector-mode-map (kbd "M-RET") 'sly-inspector-copy-down-to-repl)
@@ -133,12 +130,18 @@ emptied.See also `sly-mrepl-hook'")
     (set (make-local-variable 'sly-mrepl--prompt) prompt)))
 
 (defun sly-mrepl--prompt ()
+  (when (and sly-mrepl--dedicated-stream
+             (process-live-p sly-mrepl--dedicated-stream))
+    ;; This non-blocking call should be enough to allow asynch calls
+    ;; to `sly-mrepl--insert-output' to still see the correct value
+    ;; for `sly-mrepl--output-marker' just before we set it.
+    (accept-process-output))
   (sly-mrepl--insert (pcase (current-column)
-				(0 "")
-				(t "\n")))
+                       (0 "")
+                       (t "\n")))
   (set-marker sly-mrepl--output-mark (sly-mrepl--mark))
   (sly-mrepl--insert (format "%s> "
-			      sly-mrepl--prompt))
+                             sly-mrepl--prompt))
   (sly-mrepl--recenter))
 
 (defun sly-mrepl--recenter ()
@@ -169,18 +172,12 @@ emptied.See also `sly-mrepl-hook'")
                (sly-mrepl--insert "\n"))
       (when (null values)
         (sly-mrepl--insert "; No values"))
-      (when (and sly-mrepl--dedicated-stream
-                 (process-live-p sly-mrepl--dedicated-stream))
-        ;; This non-blocking call should be enough to allow
-        ;; `sly-mrepl--insert-output' to still see the correct value
-        ;; for `sly-mrepl--output-marker', before `sly-mrepl-prompt'
-        ;; sets it.
-        (accept-process-output))
       (sly-mrepl--prompt))))
 
-(sly-define-channel-method listener :evaluation-aborted ()
+(sly-define-channel-method listener :evaluation-aborted (&optional condition)
   (with-current-buffer (sly-channel-get self 'buffer)
-    (sly-mrepl--insert "; Evaluation aborted\n")))
+    (sly-mrepl--insert (format "; Evaluation aborted on %s\n" condition))
+    (sly-mrepl--prompt)))
 
 (sly-define-channel-method listener :write-string (string)
   (with-current-buffer (sly-channel-get self 'buffer)

contrib/swank-mrepl.lisp

@@ -42,7 +42,8 @@
    (env        :initarg  :env    :accessor env)
    (mode       :initform :eval   :accessor channel-mode)
    (tag        :initform nil)
-   (dedicated  :initform nil     :accessor dedicated)))
+   (out                          :reader out)
+   (in                           :reader in)))
 
 (defmethod initialize-instance :after ((channel listener-channel)
                                        &rest initargs)
@@ -51,7 +52,12 @@
   (setf (slot-value channel 'swank::thread)
         (if (use-threads-p)
             (spawn-listener-thread *emacs-connection* channel)
-            nil)))
+            nil))
+  (setf (slot-value channel 'out)
+        (or (and *use-dedicated-output-stream*
+                 (open-dedicated-output-stream channel))
+            (make-listener-output-stream channel)))
+  (setf (slot-value channel 'in) (make-listener-input-stream channel)))
 
 (defun package-prompt (package)
   (reduce (lambda (x y) (if (<= (length x) (length y)) x y))
@@ -65,9 +71,6 @@
               :name (format nil "mrepl listener for remote ~a" remote)))
          (thread (channel-thread ch)))
 
-    (when *use-dedicated-output-stream*
-      (setf (dedicated ch) (open-dedicated-output-stream ch)))
-
     (setf (slot-value ch 'env) (initial-listener-env ch))
     
     (when thread
@@ -80,11 +83,11 @@
 (defvar *history* nil)
 
 (defun initial-listener-env (channel)
-  (let* ((out (make-listener-output-stream channel))
-         (in (make-listener-input-stream channel))
+  (let* ((out (out channel))
+         (in (in channel))
          (io (make-two-way-stream in out)))
     `((cl:*package* . ,*package*)
-      (cl:*standard-output* . ,(or (dedicated channel) out))
+      (cl:*standard-output* . ,out)
       (cl:*standard-input*  . ,in)
       (cl:*trace-output*    . ,out)
       (cl:*error-output*    . ,out)
@@ -153,10 +156,16 @@
 	(let ((p *package*)
               results)
           (unwind-protect
-               (progn (setq results (with-sly-interrupts (read-eval-print string)))
-                      (setq aborted nil))
+               (handler-case
+                   (progn
+                     (setq results (with-sly-interrupts (read-eval-print string))
+                           aborted nil))
+                 (error (err)
+                   (setq aborted err)))
+            (flush-streams channel)
             (cond (aborted
-                   (send-to-remote-channel remote `(:evaluation-aborted)))
+                   (send-to-remote-channel remote `(:evaluation-aborted
+                                                    ,(prin1-to-string aborted))))
                   (t
                    (when /
                      (setq *** **  ** *  * (car /)
@@ -168,13 +177,14 @@
             (loop for binding in env 
                   do (setf (cdr binding) (symbol-value (car binding))))))))))
 
+(defun flush-streams (channel)
+  (with-slots (in out) channel
+    (force-output out)
+    (clear-input in)))
+
 (defun send-prompt (channel)
   (with-slots (env remote) channel
-    (let ((pkg (or (cdr (assoc '*package* env)) *package*))
-	  (out (cdr (assoc '*standard-output* env)))
-	  (in (cdr (assoc '*standard-input* env))))
-      (when out (force-output out))
-      (when in (clear-input in))
+    (let ((pkg (or (cdr (assoc '*package* env)) *package*)))
       (send-to-remote-channel remote `(:prompt ,(package-name pkg)
                                                ,(package-prompt pkg))))))