[slime-cvs] CVS slime
heller
heller at common-lisp.net
Fri Aug 8 13:43:41 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv26769
Modified Files:
ChangeLog swank-abcl.lisp swank-allegro.lisp
swank-backend.lisp swank-ecl.lisp swank-lispworks.lisp
swank-openmcl.lisp swank-sbcl.lisp swank-scl.lisp swank.lisp
Log Message:
Spawn the auto-flush thread in the front end.
This removes some copy&paste code in various backends.
* swank.lisp (auto-flush-loop): New function.
(open-streams): Use it.
* swank-backend.lisp (make-stream-interactive): Deleted.
--- /project/slime/cvsroot/slime/ChangeLog 2008/08/08 11:44:14 1.1410
+++ /project/slime/cvsroot/slime/ChangeLog 2008/08/08 13:43:33 1.1411
@@ -1,5 +1,14 @@
2008-08-08 Helmut Eller <heller at common-lisp.net>
+ Spawn the auto-flush thread in the front end.
+ This removes some copy&paste code in various backends.
+
+ * swank.lisp (auto-flush-loop): New function.
+ (open-streams): Use it.
+ * swank-backend.lisp (make-stream-interactive): Deleted.
+
+2008-08-08 Helmut Eller <heller at common-lisp.net>
+
* slime.el (test disconnect): Call slime-inferior-process
with explicit connection argument to avoid clashes with
buffer-local connections.
--- /project/slime/cvsroot/slime/swank-abcl.lisp 2008/04/17 14:56:43 1.49
+++ /project/slime/cvsroot/slime/swank-abcl.lisp 2008/08/08 13:43:33 1.50
@@ -524,30 +524,6 @@
(defimplementation receive ()
(ext:mailbox-read (mailbox (ext:current-thread))))
-;;; Auto-flush streams
-
-;; XXX race conditions
-(defvar *auto-flush-streams* '())
-
-(defvar *auto-flush-thread* nil)
-
-(defimplementation make-stream-interactive (stream)
- (setq *auto-flush-streams* (adjoin stream *auto-flush-streams*))
- (unless *auto-flush-thread*
- (setq *auto-flush-thread*
- (ext:make-thread #'flush-streams
- :name "auto-flush-thread"))))
-
-(defun flush-streams ()
- (loop
- (setq *auto-flush-streams*
- (remove-if (lambda (x)
- (not (and (open-stream-p x)
- (output-stream-p x))))
- *auto-flush-streams*))
- (mapc #'finish-output *auto-flush-streams*)
- (sleep 0.15)))
-
(defimplementation quit-lisp ()
(ext:exit))
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2008/08/07 08:10:01 1.108
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2008/08/08 13:43:33 1.109
@@ -124,9 +124,6 @@
(:class
(describe (find-class symbol)))))
-(defimplementation make-stream-interactive (stream)
- (setf (interactive-stream-p stream) t))
-
;;;; Debugger
(defvar *sldb-topframe*)
--- /project/slime/cvsroot/slime/swank-backend.lisp 2008/08/06 19:51:29 1.140
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2008/08/08 13:43:33 1.141
@@ -453,15 +453,6 @@
The streams are returned as two values.")
-(definterface make-stream-interactive (stream)
- "Do any necessary setup to make STREAM work interactively.
-This is called for each stream used for interaction with the user
-\(e.g. *standard-output*). An implementation could setup some
-implementation-specific functions to control output flushing at the
-like."
- (declare (ignore stream))
- nil)
-
;;;; Documentation
--- /project/slime/cvsroot/slime/swank-ecl.lisp 2008/08/05 17:38:44 1.24
+++ /project/slime/cvsroot/slime/swank-ecl.lisp 2008/08/08 13:43:33 1.25
@@ -537,40 +537,8 @@
;interrupt-process will halt this if it takes longer than 1sec
(sleep 1)))))
- ;; Auto-flush streams
- (defvar *auto-flush-interval* 0.15
- "How often to flush interactive streams. This valu is passed
- directly to cl:sleep.")
-
- (defvar *auto-flush-lock* (make-lock :name "auto flush"))
-
- (defvar *auto-flush-thread* nil)
-
- (defvar *auto-flush-streams* '())
-
- (defimplementation make-stream-interactive (stream)
- (mp:with-lock (*auto-flush-lock*)
- (pushnew stream *auto-flush-streams*)
- (unless *auto-flush-thread*
- (setq *auto-flush-thread*
- (spawn #'flush-streams
- :name "auto-flush-thread")))))
-
(defmethod stream-finish-output ((stream stream))
(finish-output stream))
- (defun flush-streams ()
- (loop
- (mp:with-lock (*auto-flush-lock*)
- (setq *auto-flush-streams*
- (remove-if (lambda (x)
- (not (and (open-stream-p x)
- (output-stream-p x))))
- *auto-flush-streams*))
- (dolist (i *auto-flush-streams*)
- (ignore-errors (stream-finish-output i))
- (ignore-errors (finish-output i))))
- (sleep *auto-flush-interval*)))
-
)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/08/07 07:53:47 1.107
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/08/08 13:43:33 1.108
@@ -787,29 +787,6 @@
(defmethod env-internals:environment-display-debugger (env)
*debug-io*)))
-(defvar *auto-flush-interval* 0.15)
-(defvar *auto-flush-lock* (mp:make-lock :name "auto-flush-lock"))
-(defvar *auto-flush-thread* nil)
-(defvar *auto-flush-streams* '())
-
-(defimplementation make-stream-interactive (stream)
- (mp:with-lock (*auto-flush-lock*)
- (pushnew stream *auto-flush-streams*)
- (unless *auto-flush-thread*
- (setq *auto-flush-thread*
- (mp:process-run-function "auto-flush-thread [SWANK]" ()
- #'flush-streams)))))
-
-(defun flush-streams ()
- (loop
- (mp:with-lock (*auto-flush-lock*)
- (setq *auto-flush-streams*
- (remove-if (lambda (x)
- (not (and (open-stream-p x)
- (output-stream-p x))))
- *auto-flush-streams*))
- (mapc #'finish-output *auto-flush-streams*))
- (sleep *auto-flush-interval*)))
(defmethod env-internals:confirm-p ((e slime-env) &optional msg &rest args)
(apply (swank-sym :y-or-n-p-in-emacs) msg args))
--- /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/08/06 19:51:29 1.130
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/08/08 13:43:33 1.131
@@ -193,11 +193,6 @@
(defimplementation emacs-connected ()
(setq ccl::*interactive-abort-process* ccl::*current-process*))
-(defimplementation make-stream-interactive (stream)
- (typecase stream
- (ccl:fundamental-output-stream
- (push stream ccl::*auto-flush-streams*))))
-
;;; Unix signals
(defimplementation call-without-interrupts (fn)
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/08/06 21:50:37 1.209
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/08/08 13:43:33 1.210
@@ -1319,37 +1319,6 @@
mutex))
(sb-ext:timeout ()))))))
- ;; Auto-flush streams
-
- (defvar *auto-flush-interval* 0.15
- "How often to flush interactive streams. This value is passed
- directly to cl:sleep.")
-
- (defvar *auto-flush-lock* (sb-thread:make-mutex :name "auto flush"))
-
- (defvar *auto-flush-thread* nil)
-
- (defvar *auto-flush-streams* '())
-
- (defimplementation make-stream-interactive (stream)
- (sb-thread:with-mutex (*auto-flush-lock*)
- (pushnew stream *auto-flush-streams*)
- (unless *auto-flush-thread*
- (setq *auto-flush-thread*
- (sb-thread:make-thread #'flush-streams
- :name "auto-flush-thread")))))
-
- (defun flush-streams ()
- (loop
- (sb-thread:with-mutex (*auto-flush-lock*)
- (setq *auto-flush-streams*
- (remove-if (lambda (x)
- (not (and (open-stream-p x)
- (output-stream-p x))))
- *auto-flush-streams*))
- (mapc #'finish-output *auto-flush-streams*))
- (sleep *auto-flush-interval*)))
-
)
(defimplementation quit-lisp ()
--- /project/slime/cvsroot/slime/swank-scl.lisp 2008/08/07 07:53:47 1.21
+++ /project/slime/cvsroot/slime/swank-scl.lisp 2008/08/08 13:43:33 1.22
@@ -349,11 +349,6 @@
(input (make-slime-input-stream input-fn output)))
(values input output)))
-(defimplementation make-stream-interactive (stream)
- (when (or (typep stream 'slime-input-stream)
- (typep stream 'slime-output-stream))
- (setf (slot-value stream 'interactive) t)))
-
;;;; Compilation Commands
--- /project/slime/cvsroot/slime/swank.lisp 2008/08/06 19:51:29 1.553
+++ /project/slime/cvsroot/slime/swank.lisp 2008/08/08 13:43:33 1.554
@@ -725,7 +725,9 @@
(io (make-two-way-stream in out))
(repl-results (make-output-stream-for-target connection
:repl-result)))
- (mapc #'make-stream-interactive (list in out io))
+ (when (eq (connection.communication-style connection) :spawn)
+ (spawn (lambda () (auto-flush-loop out))
+ :name "auto-flush-thread"))
(values dedicated-output in out io repl-results)))))
;; FIXME: if wait-for-event aborts the event will stay in the queue forever.
@@ -916,6 +918,16 @@
(setf (connection.repl-thread connection)
(spawn-repl-thread connection "new-repl-thread"))))))
+(defvar *auto-flush-interval* 0.2)
+
+(defun auto-flush-loop (stream)
+ (loop
+ (when (not (and (open-stream-p stream)
+ (output-stream-p stream)))
+ (return nil))
+ (finish-output stream)
+ (sleep *auto-flush-interval*)))
+
(defun find-worker-thread (id)
(etypecase id
((member t)
More information about the slime-cvs
mailing list