[slime-cvs] CVS slime
heller
heller at common-lisp.net
Mon Aug 4 21:38:08 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv3451
Modified Files:
ChangeLog swank-allegro.lisp swank-clisp.lisp swank-gray.lisp
swank-lispworks.lisp swank-openmcl.lisp swank-sbcl.lisp
Log Message:
* swank-gray.lisp (slime-output-stream): Undo last change.
Make force-output and finish-output do the same.
--- /project/slime/cvsroot/slime/ChangeLog 2008/08/04 20:25:55 1.1390
+++ /project/slime/cvsroot/slime/ChangeLog 2008/08/04 21:38:07 1.1391
@@ -1,3 +1,8 @@
+2008-08-04 Helmut Eller <heller at common-lisp.net>
+
+ * swank-gray.lisp (slime-output-stream): Undo last change.
+ Make force-output and finish-output do the same.
+
2008-08-04 Masayuki Onjo <masayuki.onjo at gmail.com>
Updates for CLISP-2.46.
--- /project/slime/cvsroot/slime/swank-allegro.lisp 2008/08/04 20:25:42 1.105
+++ /project/slime/cvsroot/slime/swank-allegro.lisp 2008/08/04 21:38:07 1.106
@@ -125,9 +125,7 @@
(describe (find-class symbol)))))
(defimplementation make-stream-interactive (stream)
- (setf (interactive-stream-p stream) t)
- (when (typep stream 'slime-output-stream)
- (setf (slot-value stream 'interactive-p) t)))
+ (setf (interactive-stream-p stream) t))
;;;; Debugger
--- /project/slime/cvsroot/slime/swank-clisp.lisp 2008/08/04 20:25:50 1.71
+++ /project/slime/cvsroot/slime/swank-clisp.lisp 2008/08/04 21:38:07 1.72
@@ -577,8 +577,9 @@
(load fasl-file))
nil))))
-(defimplementation swank-compile-string (string &key buffer position directory)
- (declare (ignore directory))
+(defimplementation swank-compile-string (string &key buffer position directory
+ debug)
+ (declare (ignore directory debug))
(with-compilation-hooks ()
(let ((*buffer-name* buffer)
(*buffer-offset* position))
--- /project/slime/cvsroot/slime/swank-gray.lisp 2008/08/04 20:25:38 1.11
+++ /project/slime/cvsroot/slime/swank-gray.lisp 2008/08/04 21:38:07 1.12
@@ -15,57 +15,43 @@
(buffer :initform (make-string 8000))
(fill-pointer :initform 0)
(column :initform 0)
- ;; true if the Lisp system flushes this stream periodically
- (interactive-p :initform nil)
(lock :initform (make-recursive-lock :name "buffer write lock"))))
+(defmacro with-slime-output-stream (stream &body body)
+ `(with-slots (lock output-fn buffer fill-pointer column) ,stream
+ (call-with-recursive-lock-held lock (lambda () , at body))))
+
(defmethod stream-write-char ((stream slime-output-stream) char)
- (call-with-recursive-lock-held
- (slot-value stream 'lock)
- (lambda ()
- (with-slots (buffer fill-pointer column) stream
- (setf (schar buffer fill-pointer) char)
- (incf fill-pointer)
- (incf column)
- (when (char= #\newline char)
- (setf column 0)
- (force-output stream))
- (when (= fill-pointer (length buffer))
- (finish-output stream)))))
+ (with-slime-output-stream stream
+ (setf (schar buffer fill-pointer) char)
+ (incf fill-pointer)
+ (incf column)
+ (when (char= #\newline char)
+ (setf column 0))
+ (when (= fill-pointer (length buffer))
+ (finish-output stream)))
char)
(defmethod stream-line-column ((stream slime-output-stream))
- (call-with-recursive-lock-held
- (slot-value stream 'lock)
- (lambda ()
- (slot-value stream 'column))))
+ (with-slime-output-stream stream column))
(defmethod stream-line-length ((stream slime-output-stream))
75)
(defmethod stream-finish-output ((stream slime-output-stream))
- (with-slots (buffer lock fill-pointer output-fn) stream
- (call-with-recursive-lock-held
- lock
- (lambda ()
- (unless (zerop fill-pointer)
- (funcall output-fn (subseq buffer 0 fill-pointer))
- (setf fill-pointer 0)))))
+ (with-slime-output-stream stream
+ (unless (zerop fill-pointer)
+ (funcall output-fn (subseq buffer 0 fill-pointer))
+ (setf fill-pointer 0)))
nil)
(defmethod stream-force-output ((stream slime-output-stream))
- (with-slots (interactive-p) stream
- (unless interactive-p
- (stream-finish-output stream)))
- nil)
+ (stream-finish-output stream))
(defmethod stream-fresh-line ((stream slime-output-stream))
- (call-with-recursive-lock-held
- (slot-value stream 'lock)
- (lambda ()
- (with-slots (column) stream
- (cond ((zerop column) nil)
- (t (terpri stream) t))))))
+ (with-slime-output-stream stream
+ (cond ((zerop column) nil)
+ (t (terpri stream) t))))
(defclass slime-input-stream (fundamental-character-input-stream)
((output-stream :initarg :output-stream)
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/08/04 20:25:38 1.103
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/08/04 21:38:07 1.104
@@ -800,9 +800,7 @@
nil)
(let ((lw:*handle-warn-on-redefinition* :warn))
(defmethod stream:stream-soft-force-output ((o (eql stream)))
- (force-output o))
- (when (typep stream 'slime-output-stream)
- (setf (slot-value stream 'interactive-p) t)))))
+ (force-output o)))))
(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/04 20:25:42 1.128
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp 2008/08/04 21:38:07 1.129
@@ -194,9 +194,9 @@
(setq ccl::*interactive-abort-process* ccl::*current-process*))
(defimplementation make-stream-interactive (stream)
- (when (typep stream 'slime-output-stream)
- (push stream ccl::*auto-flush-streams*)
- (setf (slot-value stream 'interactive-p) t)))
+ (typecase stream
+ (ccl:fundamental-output-stream
+ (push stream ccl::*auto-flush-streams*))))
;;; Unix signals
--- /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/08/04 20:25:38 1.203
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp 2008/08/04 21:38:07 1.204
@@ -1311,7 +1311,7 @@
;; Auto-flush streams
(defvar *auto-flush-interval* 0.15
- "How often to flush interactive streams. This valu is passed
+ "How often to flush interactive streams. This value is passed
directly to cl:sleep.")
(defvar *auto-flush-lock* (make-recursive-lock :name "auto flush"))
@@ -1328,9 +1328,7 @@
(unless *auto-flush-thread*
(setq *auto-flush-thread*
(sb-thread:make-thread #'flush-streams
- :name "auto-flush-thread")))))
- (when (typep stream 'slime-output-stream)
- (setf (slot-value stream 'interactive-p) t)))
+ :name "auto-flush-thread"))))))
(defun flush-streams ()
(loop
More information about the slime-cvs
mailing list