[slime-cvs] CVS update: slime/swank.lisp slime/swank-cmucl.lisp slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/null-swank-impl.lisp
Helmut Eller
heller at common-lisp.net
Sun Nov 2 23:08:04 UTC 2003
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv28860
Modified Files:
swank.lisp swank-cmucl.lisp swank-sbcl.lisp swank-openmcl.lisp
null-swank-impl.lisp
Log Message:
Input redirection works now on the line level, like a tty.
Output streams are now line buffered.
We no longer compute the backtrace-length.
Date: Sun Nov 2 18:08:04 2003
Author: heller
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.51 slime/swank.lisp:1.52
--- slime/swank.lisp:1.51 Sat Nov 1 19:55:10 2003
+++ slime/swank.lisp Sun Nov 2 18:08:03 2003
@@ -82,7 +82,8 @@
(*trace-output* *slime-output*)
(*debug-io* *slime-io*)
(*query-io* *slime-io*)
- (*standard-input* *slime-input*))
+ (*standard-input* *slime-input*)
+ (*terminal-io* *slime-io*))
(apply #'funcall form))
(apply #'funcall form))))
@@ -171,12 +172,12 @@
(defvar *read-input-catch-tag* 0)
-(defun slime-read-char ()
+(defun slime-read-string ()
(force-output)
(let ((*read-input-catch-tag* (1+ *read-input-catch-tag*)))
- (send-to-emacs `(:read-char ,*read-input-catch-tag*))
- (code-char (catch *read-input-catch-tag*
- (loop (read-from-emacs))))))
+ (send-to-emacs `(:read-string ,*read-input-catch-tag*))
+ (catch *read-input-catch-tag*
+ (loop (read-from-emacs)))))
(defslimefun take-input (tag input)
(throw tag input))
@@ -255,6 +256,7 @@
(package-name *package*))
(defslimefun listener-eval (string)
+ (clear-input *slime-input*)
(multiple-value-bind (values last-form) (eval-region string t)
(setq +++ ++ ++ + + last-form
*** ** ** * * (car values)
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.15 slime/swank-cmucl.lisp:1.16
--- slime/swank-cmucl.lisp:1.15 Sat Nov 1 10:43:05 2003
+++ slime/swank-cmucl.lisp Sun Nov 2 18:08:03 2003
@@ -19,53 +19,121 @@
;;; TCP Server.
(defstruct (slime-output-stream
- (:include lisp::string-output-stream
- (lisp::misc #'slime-out-misc)))
- (last-charpos 0 :type kernel:index))
-
-(defun slime-out-misc (stream operation &optional arg1 arg2)
+ (:include lisp::lisp-stream
+ (lisp::misc #'sos/misc)
+ (lisp::out #'sos/out)
+ (lisp::sout #'sos/sout))
+ (:conc-name sos.))
+ (buffer (make-string 512) :type string)
+ (index 0 :type kernel:index)
+ (column 0 :type kernel:index))
+
+(defun sos/out (stream char)
+ (let ((buffer (sos.buffer stream))
+ (index (sos.index stream)))
+ (setf (schar buffer index) char)
+ (setf (sos.index stream) (1+ index))
+ (incf (sos.column stream))
+ (cond ((char= #\newline char)
+ (force-output stream)
+ (setf (sos.column stream) 0))
+ ((= index (length buffer))
+ (force-output stream))))
+ char)
+
+(defun sos/sout (stream string start end)
+ (loop for i from start below end
+ do (sos/out stream (aref string i))))
+
+(defun sos/misc (stream operation &optional arg1 arg2)
+ (declare (ignore arg1 arg2))
(case operation
(:force-output
- (unless (zerop (lisp::string-output-stream-index stream))
- (setf (slime-output-stream-last-charpos stream)
- (slime-out-misc stream :charpos))
- (send-to-emacs `(:read-output ,(get-output-stream-string stream)))))
+ (let ((end (sos.index stream)))
+ (unless (zerop end)
+ (send-to-emacs `(:read-output ,(subseq (sos.buffer stream) 0 end)))
+ (setf (sos.index stream) 0))))
+ (:charpos (sos.column stream))
+ (:line-length 75)
(:file-position nil)
- (:charpos
- (do ((index (1- (the fixnum (lisp::string-output-stream-index stream)))
- (1- index))
- (count 0 (1+ count))
- (string (lisp::string-output-stream-string stream)))
- ((< index 0) (+ count (slime-output-stream-last-charpos stream)))
- (declare (simple-string string)
- (fixnum index count))
- (if (char= (schar string index) #\newline)
- (return count))))
- (t (lisp::string-out-misc stream operation arg1 arg2))))
+ (:element-type 'base-char)
+ (:get-command nil)
+ (t (format *terminal-io* "~&~Astream: ~S~%" stream operation))))
(defstruct (slime-input-stream
- (:include sys:lisp-stream
- (lisp::in #'slime-input-stream-read-char)
- (lisp::misc #'slime-input-stream-misc-ops)))
- (buffered-char nil :type (or null character)))
-
-(defun slime-input-stream-read-char (stream &optional eoferr eofval)
- (declare (ignore eoferr eofval))
- (let ((c (slime-input-stream-buffered-char stream)))
- (cond (c (setf (slime-input-stream-buffered-char stream) nil) c)
- (t (slime-read-char)))))
+ (:include string-stream
+ (lisp::in #'sis/in)
+ (lisp::misc #'sis/misc))
+ (:conc-name sis.))
+ (buffer "" :type string)
+ (index 0 :type kernel:index))
+
+(defun sis/in (stream eof-errorp eof-value)
+ (let ((index (sis.index stream))
+ (buffer (sis.buffer stream)))
+ (when (= index (length buffer))
+ (setf buffer (slime-read-string))
+ (setf (sis.buffer stream) buffer)
+ (setf index 0))
+ (prog1 (aref buffer index)
+ (setf (sis.index stream) (1+ index)))))
-(defun slime-input-stream-misc-ops (stream operation &optional arg1 arg2)
+(defun sis/misc (stream operation &optional arg1 arg2)
(declare (ignore arg2))
(ecase operation
- (:unread
- (assert (not (slime-input-stream-buffered-char stream)))
- (setf (slime-input-stream-buffered-char stream) arg1)
- nil)
- (:listen nil)
- (:clear-input (setf (slime-input-stream-buffered-char stream) nil))
(:file-position nil)
- (:charpos nil)))
+ (:file-length nil)
+ (:unread (setf (aref (sis.buffer stream)
+ (decf (sis.index stream)))
+ arg1))
+ (:clear-input (setf (sis.index stream) 0
+ (sis.buffer stream) ""))
+ (:listen (< (sis.index stream) (length (sis.buffer stream))))
+ (:charpos nil)
+ (:line-length nil)
+ (:get-command nil)
+ (:element-type 'base-char)))
+
+
+;; (eval-when (:load-toplevel :compile-toplevel :execute)
+;; (require :gray-streams))
+;;
+;; (defclass slime-input-stream (ext:fundamental-character-input-stream)
+;; ((buffer :initform "") (index :initform 0)))
+;;
+;; (defmethod ext:stream-read-char ((s slime-input-stream))
+;; (with-slots (buffer index) s
+;; (when (= index (length buffer))
+;; (setf buffer (slime-read-string))
+;; (setf index 0))
+;; (assert (plusp (length buffer)))
+;; (prog1 (aref buffer index) (incf index))))
+;;
+;; (defmethod ext:stream-listen ((s slime-input-stream))
+;; (with-slots (buffer index) s
+;; (< index (length buffer))))
+;;
+;; (defmethod ext:stream-unread-char ((s slime-input-stream) char)
+;; (with-slots (buffer index) s
+;; (setf (aref buffer (decf index)) char))
+;; nil)
+;;
+;; (defmethod ext:stream-clear-input ((s slime-input-stream))
+;; (with-slots (buffer index) s
+;; (setf buffer ""
+;; index 0))
+;; nil)
+;;
+;; (defmethod ext:stream-line-column ((s slime-input-stream))
+;; nil)
+;;
+;; (defmethod ext:stream-line-length ((s slime-input-stream))
+;; 75)
+;;
+;; (defun make-slime-input-stream ()
+;; (make-instance 'slime-input-stream))
+
+
(defun create-swank-server (port &key reuse-address (address "localhost"))
"Create a SWANK TCP server."
@@ -107,7 +175,8 @@
(when *swank-debug-p*
(format *debug-io* "~&;; Connection to Emacs lost.~%;; [~A]~%" e))
(sys:invalidate-descriptor (sys:fd-stream-fd *emacs-io*))
- (close *emacs-io*))))))
+ (close *emacs-io*)))))
+ (sys:scrub-control-stack))
;;;
@@ -636,12 +705,6 @@
(let ((*print-pretty* nil))
(debug::print-frame-call frame :verbosity 1 :number t)))))
-(defun backtrace-length ()
- "Return the number of frames on the stack."
- (do ((frame *sldb-stack-top* (di:frame-down frame))
- (i 0 (1+ i)))
- ((not frame) i)))
-
(defun compute-backtrace (start end)
"Return a list of frames starting with frame number START and
continuing to frame number END or, if END is nil, the last frame on the
@@ -658,7 +721,6 @@
(defslimefun debugger-info-for-emacs (start end)
(list (format-condition-for-emacs)
(format-restarts-for-emacs)
- (backtrace-length)
(backtrace-for-emacs start end)))
(defun code-location-source-path (code-location)
Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.17 slime/swank-sbcl.lisp:1.18
--- slime/swank-sbcl.lisp:1.17 Sat Nov 1 10:48:19 2003
+++ slime/swank-sbcl.lisp Sun Nov 2 18:08:03 2003
@@ -161,52 +161,72 @@
;; This buffering is done via a Gray stream instead of the CMU-specific
;; stream method business...
+
(defclass slime-output-stream (sb-gray:fundamental-character-output-stream)
- ((buffer :initform (make-array 512 :element-type 'character
- :fill-pointer 0 :adjustable t))
- (last-charpos :initform 0)))
+ ((buffer :initform (make-string 512))
+ (fill-pointer :initform 0)
+ (column :initform 0)))
(defmethod sb-gray:stream-write-char ((stream slime-output-stream) char)
- (vector-push-extend char (slot-value stream 'buffer))
+ (with-slots (buffer fill-pointer column) stream
+ (setf (schar buffer fill-pointer) char)
+ (incf fill-pointer)
+ (incf column)
+ (cond ((char= #\newline char)
+ (force-output stream)
+ (setf column 0))
+ ((= fill-pointer (length buffer))
+ (force-output stream))))
char)
(defmethod sb-gray:stream-line-column ((stream slime-output-stream))
- (with-slots (buffer last-charpos) stream
- (do ((index (1- (fill-pointer buffer)) (1- index))
- (count 0 (1+ count)))
- ((< index 0) (+ count last-charpos))
- (when (char= (aref buffer index) #\newline)
- (return count)))))
+ (slot-value stream 'column))
+
+(defmethod sb-gray:stream-line-length ((stream slime-output-stream))
+ 75)
(defmethod sb-gray:stream-force-output ((stream slime-output-stream))
- (with-slots (buffer last-charpos) stream
- (let ((end (fill-pointer buffer)))
+ (with-slots (buffer fill-pointer last-charpos) stream
+ (let ((end fill-pointer))
(unless (zerop end)
(send-to-emacs `(:read-output ,(subseq buffer 0 end)))
- (setf last-charpos (sb-gray:stream-line-column stream))
- (setf (fill-pointer buffer) 0))))
+ (setf fill-pointer 0))))
nil)
+(defun make-slime-output-stream ()
+ (make-instance 'slime-output-stream))
+
(defclass slime-input-stream (sb-gray:fundamental-character-input-stream)
- ((buffered-char :initform nil)))
+ ((buffer :initform "") (index :initform 0)))
(defmethod sb-gray:stream-read-char ((s slime-input-stream))
- (with-slots (buffered-char) s
- (cond (buffered-char (prog1 buffered-char (setf buffered-char nil)))
- (t (slime-read-char)))))
+ (with-slots (buffer index) s
+ (when (= index (length buffer))
+ (setf buffer (slime-read-string))
+ (setf index 0))
+ (assert (plusp (length buffer)))
+ (prog1 (aref buffer index) (incf index))))
+
+(defmethod sb-gray:stream-listen ((s slime-input-stream))
+ (with-slots (buffer index) s
+ (< index (length buffer))))
(defmethod sb-gray:stream-unread-char ((s slime-input-stream) char)
- (setf (slot-value s 'buffered-char) char)
+ (with-slots (buffer index) s
+ (setf (aref buffer (decf index)) char))
nil)
-(defmethod sb-gray:stream-listen ((s slime-input-stream))
+(defmethod sb-gray:stream-clear-input ((s slime-input-stream))
+ (with-slots (buffer index) s
+ (setf buffer ""
+ index 0))
nil)
(defmethod sb-gray:stream-line-column ((s slime-input-stream))
nil)
(defmethod sb-gray:stream-line-length ((s slime-input-stream))
- nil)
+ 75)
;;; Utilities
@@ -519,12 +539,6 @@
(let ((*print-pretty* nil))
(sb-debug::print-frame-call frame :verbosity 1 :number t)))))
-(defun backtrace-length ()
- "Return the number of frames on the stack."
- (do ((frame *sldb-stack-top* (sb-di:frame-down frame))
- (i 0 (1+ i)))
- ((not frame) i)))
-
(defun compute-backtrace (start end)
"Return a list of frames starting with frame number START and
continuing to frame number END or, if END is nil, the last frame on the
@@ -544,7 +558,6 @@
(defslimefun debugger-info-for-emacs (start end)
(list (format-condition-for-emacs)
(format-restarts-for-emacs)
- (backtrace-length)
(backtrace-for-emacs start end)))
(defun code-location-source-path (code-location)
Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.16 slime/swank-openmcl.lisp:1.17
--- slime/swank-openmcl.lisp:1.16 Sat Nov 1 10:48:19 2003
+++ slime/swank-openmcl.lisp Sun Nov 2 18:08:03 2003
@@ -13,7 +13,7 @@
;;; The LLGPL is also available online at
;;; http://opensource.franz.com/preamble.html
;;;
-;;; $Id: swank-openmcl.lisp,v 1.16 2003/11/01 15:48:19 heller Exp $
+;;; $Id: swank-openmcl.lisp,v 1.17 2003/11/02 23:08:03 heller Exp $
;;;
;;;
@@ -103,53 +103,67 @@
;; This buffering is done via a Gray stream instead of the CMU-specific
;; stream method business...
+
(defclass slime-output-stream (ccl:fundamental-character-output-stream)
- ((buffer :initform (make-array 512 :element-type 'character
- :fill-pointer 0 :adjustable t))
- (last-charpos :initform 0)))
+ ((buffer :initform (make-string 512))
+ (fill-pointer :initform 0)
+ (column :initform 0)))
(defmethod ccl:stream-write-char ((stream slime-output-stream) char)
- (vector-push-extend char (slot-value stream 'buffer))
+ (with-slots (buffer fill-pointer column) stream
+ (setf (schar buffer fill-pointer) char)
+ (incf fill-pointer)
+ (incf column)
+ (cond ((char= #\newline char)
+ (force-output stream)
+ (setf column 0))
+ ((= fill-pointer (length buffer))
+ (force-output stream))))
char)
(defmethod ccl:stream-line-column ((stream slime-output-stream))
- (with-slots (buffer last-charpos) stream
- (do ((index (1- (fill-pointer buffer)) (1- index))
- (count 0 (1+ count)))
- ((< index 0) (+ count last-charpos))
- (when (char= (aref buffer index) #\newline)
- (return count)))))
+ (slot-value stream 'column))
(defmethod ccl:stream-force-output ((stream slime-output-stream))
- (with-slots (buffer last-charpos) stream
- (let ((end (fill-pointer buffer)))
+ (with-slots (buffer fill-pointer last-charpos) stream
+ (let ((end fill-pointer))
(unless (zerop end)
(send-to-emacs `(:read-output ,(subseq buffer 0 end)))
- (setf last-charpos (ccl:stream-line-column stream))
- (setf (fill-pointer buffer) 0))))
+ (setf fill-pointer 0))))
nil)
+(defun make-slime-output-stream ()
+ (make-instance 'slime-output-stream))
+
(defclass slime-input-stream (ccl:fundamental-character-input-stream)
- ((buffered-char :initform nil)))
+ ((buffer :initform "") (index :initform 0)))
(defmethod ccl:stream-read-char ((s slime-input-stream))
- (with-slots (buffered-char) s
- (cond (buffered-char (prog1 buffered-char (setf buffered-char nil)))
- (t (slime-read-char)))))
+ (with-slots (buffer index) s
+ (when (= index (length buffer))
+ (setf buffer (slime-read-string))
+ (setf index 0))
+ (assert (plusp (length buffer)))
+ (prog1 (aref buffer index) (incf index))))
+
+(defmethod ccl:stream-listen ((s slime-input-stream))
+ (with-slots (buffer index) s
+ (< index (length buffer))))
(defmethod ccl:stream-unread-char ((s slime-input-stream) char)
- (setf (slot-value s 'buffered-char) char)
+ (with-slots (buffer index) s
+ (setf (aref buffer (decf index)) char))
nil)
-(defmethod ccl:stream-listen ((s slime-input-stream))
+(defmethod ccl:stream-clear-input ((s slime-input-stream))
+ (with-slots (buffer index) s
+ (setf buffer ""
+ index 0))
nil)
(defmethod ccl:stream-line-column ((s slime-input-stream))
nil)
-(defmethod ccl:stream-line-length ((s slime-input-stream))
- nil)
-
;;; Evaluation
(defvar *swank-debugger-stack-frame*)
@@ -286,14 +300,6 @@
(funcall function frame-number p tcr lfun pc))
(incf frame-number))))))
-(defun backtrace-length ()
- "Return the total number of frames available in the debugger."
- (let ((result 0))
- (map-backtrace #'(lambda (n p tcr lfun pc)
- (declare (ignore n p tcr lfun pc))
- (incf result)))
- result))
-
(defun frame-arguments (p tcr lfun pc)
"Returns a string representing the arguments of a frame."
(multiple-value-bind (count vsp parent-vsp)
@@ -352,7 +358,6 @@
(defslimefun debugger-info-for-emacs (start end)
(list (format-condition-for-emacs)
(format-restarts-for-emacs)
- (backtrace-length)
(backtrace-for-emacs start end)))
(defslimefun frame-locals (index)
Index: slime/null-swank-impl.lisp
diff -u slime/null-swank-impl.lisp:1.2 slime/null-swank-impl.lisp:1.3
--- slime/null-swank-impl.lisp:1.2 Tue Oct 28 18:37:14 2003
+++ slime/null-swank-impl.lisp Sun Nov 2 18:08:03 2003
@@ -5,7 +5,7 @@
;;; Copyright (C) 2003, James Bielman <jamesjb at jamesjb.com>
;;; Released into the public domain; all warranties are disclaimed.
;;;
-;;; $Id: null-swank-impl.lisp,v 1.2 2003/10/28 23:37:14 jbielman Exp $
+;;; $Id: null-swank-impl.lisp,v 1.3 2003/11/02 23:08:03 heller Exp $
;;;
;; The "SWANK-IMPL" package contains functions that access the naughty
@@ -58,7 +58,6 @@
(:use :common-lisp)
(:export
#:backtrace
- #:backtrace-length
#:compile-file-trapping-conditions
#:compile-stream-trapping-conditions
#:compiler-condition
@@ -261,10 +260,6 @@
simply expands into DEFUN."
`(defun ,name (,condition ,hook)
, at body))
-
-(defun backtrace-length ()
- "Return the total number of stack frames known to the debugger."
- 0)
(defun backtrace (&optional (start 0) (end most-positive-fixnum))
"Return a list containing a backtrace of the condition current
More information about the slime-cvs
mailing list