[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv1559

Modified Files:
	ChangeLog swank.lisp 
Log Message:
* swank.lisp (listener-channel): Moved to contrib/swank-mrepl.lisp
(create-listener, initial-listener-bindings, spawn-listener-thread).

--- /project/slime/cvsroot/slime/ChangeLog	2011/12/01 22:34:41	1.2255
+++ /project/slime/cvsroot/slime/ChangeLog	2011/12/02 18:17:54	1.2256
@@ -1,3 +1,8 @@
+2011-12-02  Helmut Eller  <heller at common-lisp.net>
+
+	* swank.lisp (listener-channel): Moved to contrib/swank-mrepl.lisp
+	(create-listener, initial-listener-bindings, spawn-listener-thread).
+
 2011-12-01  Helmut Eller  <heller at common-lisp.net>
 
 	* swank-sbcl.lisp (wait-for-input): Call poll(2).
--- /project/slime/cvsroot/slime/swank.lisp	2011/12/01 16:48:21	1.766
+++ /project/slime/cvsroot/slime/swank.lisp	2011/12/02 18:17:54	1.767
@@ -1533,83 +1533,6 @@
 (defun send-to-remote-channel (channel-id msg)
   (send-to-emacs `(:channel-send ,channel-id ,msg)))
 
-(defclass listener-channel (channel)
-  ((remote :initarg :remote)
-   (env :initarg :env)))
-
-(defslimefun create-listener (remote)
-  (let* ((pkg *package*)
-         (conn *emacs-connection*)
-         (ch (make-instance 'listener-channel
-                            :remote remote
-                            :env (initial-listener-bindings remote))))
-
-    (with-slots (thread id) ch
-      (when (use-threads-p)
-        (setf thread (spawn-listener-thread ch conn)))
-      (list id
-            (thread-id thread)
-            (package-name pkg)
-            (package-string-for-prompt pkg)))))
-
-(defun initial-listener-bindings (remote)
-  `((*package* . ,*package*)
-    (*standard-output* 
-     . ,(make-listener-output-stream remote))
-    (*standard-input*
-     . ,(make-listener-input-stream remote))))
-
-(defun spawn-listener-thread (channel connection)
-  (spawn (lambda ()
-           (with-connection (connection)
-             (loop 
-              (destructure-case (wait-for-event `(:emacs-channel-send . _))
-                ((:emacs-channel-send c (selector &rest args))
-                 (assert (eq c channel))
-                 (channel-send channel selector args))))))
-         :name "swank-listener-thread"))
-
-(define-channel-method :eval ((c listener-channel) string)
-  (with-slots (remote env) c
-    (let ((aborted t))
-      (with-bindings env
-        (unwind-protect 
-             (let* ((form (read-from-string string))
-                    (value (eval form)))
-               (send-to-remote-channel remote 
-                                       `(:write-result
-                                         ,(prin1-to-string value)))
-               (setq aborted nil))
-          (force-output)
-          (setf env (loop for (sym) in env 
-                          collect (cons sym (symbol-value sym))))
-          (let ((pkg (package-name *package*))
-                (prompt (package-string-for-prompt *package*)))
-            (send-to-remote-channel remote 
-                                    (if aborted 
-                                        `(:evaluation-aborted ,pkg ,prompt)
-                                        `(:prompt ,pkg ,prompt)))))))))
-
-(defun make-listener-output-stream (remote)
-  (make-output-stream (lambda (string)
-                        (send-to-remote-channel remote
-                                                `(:write-string ,string)))))
-
-(defun make-listener-input-stream (remote)
-  (make-input-stream 
-   (lambda ()
-     (force-output)
-     (let ((tag (make-tag)))
-       (send-to-remote-channel remote 
-                               `(:read-string ,(current-thread-id) ,tag))
-       (let ((ok nil))
-         (unwind-protect
-              (prog1 (caddr (wait-for-event
-                             `(:emacs-return-string ,tag value)))
-                (setq ok t))
-           (unless ok
-             (send-to-remote-channel remote `(:read-aborted ,tag)))))))))
-
 
 
 (defun input-available-p (stream)