[slime-cvs] CVS update: slime/swank.lisp

[Helmut Eller]

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

Modified Files:
	swank.lisp 
Log Message:
slime-read-error: New condition.
(read-next-form): Re-signal the conditions as slime-read-errors.  And
check the result of read-sequence (i.e. detect CMUCL's read-sequence
bug).

(sldb-continue, throw-to-toplevel): Was more or less the same in all
backends.


Date: Wed Oct 29 18:50:16 2003
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.45 slime/swank.lisp:1.46
--- slime/swank.lisp:1.45	Fri Oct 24 21:54:00 2003
+++ slime/swank.lisp	Wed Oct 29 18:50:13 2003
@@ -71,6 +71,11 @@
 	  (apply #'funcall form))
 	(apply #'funcall form))))
 
+(define-condition slime-read-error (error) 
+  ((condition :initarg :condition :reader slime-read-error.condition))
+  (:report (lambda (condition stream)
+             (format stream "~A" (slime-read-error.condition condition)))))
+
 (defun read-next-form ()
   "Read the next Slime request from *EMACS-IO* and return an
 S-expression to be evaluated to handle the request.  If an error
@@ -81,11 +86,13 @@
         (let* ((length (logior (ash (next-byte) 16)
                                (ash (next-byte) 8)
                                (next-byte)))
-               (string (make-string length)))
-          (read-sequence string *emacs-io*)
+               (string (make-string length))
+               (pos (read-sequence string *emacs-io*)))
+          (assert (= pos length) nil 
+                  "Short read: length=~D  pos=~D" length pos)
           (read-form string))
-      (condition (c)
-        (throw 'serve-request-catcher c)))))
+      (serious-condition (c) 
+        (error (make-condition 'slime-read-error :condition c))))))
 
 (defun read-form (string)
   (with-standard-io-syntax
@@ -417,6 +424,15 @@
 
 (defslimefun load-file (filename)
   (load filename))
+
+;;;
+
+(defslimefun sldb-continue ()
+  (continue *swank-debugger-condition*))
+
+(defslimefun throw-to-toplevel ()
+  (throw 'slime-toplevel nil))
+
 
 ;;; Local Variables:
 ;;; eval: (font-lock-add-keywords 'lisp-mode '(("(\\(defslimefun\\)\\s +\\(\\(\\w\\|\\s_\\)+\\)"  (1 font-lock-keyword-face) (2 font-lock-function-name-face))))