[slime-cvs] CVS slime

[heller]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv5912

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Finally handle reader-errors without disconnecting.

* swank.lisp (decode-message): Convert reader-error conditions
into :reader-error events.
(dispatch-event): Send :reader-error events to Emacs.

* slime.el (slime-dispatch-event): Display reader-errors.

--- /project/slime/cvsroot/slime/ChangeLog	2008/08/12 12:57:02	1.1445
+++ /project/slime/cvsroot/slime/ChangeLog	2008/08/12 12:57:09	1.1446
@@ -1,5 +1,15 @@
 2008-08-12  Helmut Eller  <heller at common-lisp.net>
 
+	Finally handle reader-errors without disconnecting.
+
+	* swank.lisp (decode-message): Convert reader-error conditions
+	into :reader-error events.
+	(dispatch-event): Send :reader-error events to Emacs.
+
+	* slime.el (slime-dispatch-event): Display reader-errors.
+
+2008-08-12  Helmut Eller  <heller at common-lisp.net>
+
 	* swank.lisp (with-buffer-syntax): Take package as argument.
 	(defslimefun): Derive the package for exporting from the symbol.
 
--- /project/slime/cvsroot/slime/slime.el	2008/08/12 12:56:57	1.989
+++ /project/slime/cvsroot/slime/slime.el	2008/08/12 12:57:09	1.990
@@ -2005,8 +2005,9 @@
 (defun slime-check-version (version conn)
   (or (equal version slime-protocol-version)
       (equal slime-protocol-version 'ignore)
-      (yes-or-no-p (format "Version mismatch: %S vs. %S.  Continue? "
-                           slime-protocol-version version))
+      (yes-or-no-p 
+       (format "Version mismatch: %S (emacs) vs. %S (lisp). Continue? "
+               slime-protocol-version version))
       (slime-net-close conn)
       (top-level)))
 
@@ -2381,7 +2382,13 @@
            (assert thread)
            (message "%s" message))
           ((:ping thread tag)
-           (slime-send `(:emacs-pong ,thread ,tag)))))))
+           (slime-send `(:emacs-pong ,thread ,tag)))
+          ((:reader-error packet condition)
+           (slime-with-popup-buffer ("*Slime Error*")
+             (princ (format "Invalid protocol message:\n%s\n\n%S"
+                            condition packet))
+             (goto-char (point-min)))
+           (error "Invalid protocol message"))))))
 
 (defun slime-send (sexp)
   "Send SEXP directly over the wire on the current connection."
--- /project/slime/cvsroot/slime/swank.lisp	2008/08/12 12:57:02	1.568
+++ /project/slime/cvsroot/slime/swank.lisp	2008/08/12 12:57:09	1.569
@@ -1044,7 +1044,11 @@
     (((:emacs-pong :emacs-return :emacs-return-string) thread-id &rest args)
      (send-event (find-thread thread-id) (cons (car event) args)))
     (((:end-of-stream))
-     (close-connection *emacs-connection* nil (safe-backtrace)))))
+     (close-connection *emacs-connection* nil (safe-backtrace)))
+    ((:reader-error packet condition)
+     (encode-message `(:reader-error ,packet 
+                                     ,(safe-condition-message condition))
+                     (current-socket-io)))))
 
 (defvar *event-queue* '())
 
@@ -1418,7 +1422,10 @@
         (cond ((and (not c) timeout) (values nil t))
               (t
                (and c (unread-char c stream))
-               (values (read-form (read-packet stream)) nil)))))))
+               (let ((packet (read-packet stream)))
+                 (handler-case (values (read-form packet) nil)
+                   (reader-error (c) 
+                     `(:reader-error ,packet ,c))))))))))
 
 (defun read-packet (stream)
   (peek-char nil stream) ; wait while queuing interrupts