[slime-cvs] CVS slime

[CVS User heller]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv3602

Modified Files:
	ChangeLog slime.el swank.lisp 
Log Message:
Don't double encode results for eval-in-emacs.

* slime.el (slime-check-eval-in-emacs-result): New.
(slime-eval-for-lisp): Use it.
* swank.lisp (unreadable-object): Removed.

--- /project/slime/cvsroot/slime/ChangeLog	2011/02/02 11:12:33	1.2174
+++ /project/slime/cvsroot/slime/ChangeLog	2011/02/04 14:26:36	1.2175
@@ -1,3 +1,11 @@
+2011-02-04  Helmut Eller  <heller at common-lisp.net>
+
+	Don't double encode results for eval-in-emacs.
+
+	* slime.el (slime-check-eval-in-emacs-result): New.
+	(slime-eval-for-lisp): Use it.
+	* swank.lisp (unreadable-object): Removed.
+
 2011-02-02  Stas Boukarev  <stassats at gmail.com>
 
 	* swank.lisp (eval-in-emacs): Return unreadable results from Emacs
--- /project/slime/cvsroot/slime/slime.el	2011/02/02 10:13:07	1.1354
+++ /project/slime/cvsroot/slime/slime.el	2011/02/04 14:26:36	1.1355
@@ -4009,16 +4009,38 @@
 (defun slime-eval-for-lisp (thread tag form-string)
   (let ((ok nil) 
         (value nil)
+        (error nil)
         (c (slime-connection)))
-    (unwind-protect (progn
-                      (slime-check-eval-in-emacs-enabled)
-                      (setq value (eval (read form-string)))
-                      (setq ok t))
-      (let ((result (if ok
-                        `(:ok ,(prin1-to-string value))
-                        `(:abort))))
+    (unwind-protect 
+        (condition-case err
+            (progn
+              (slime-check-eval-in-emacs-enabled)
+              (setq value (eval (read form-string)))
+              (slime-check-eval-in-emacs-result value)
+              (setq ok t))
+          ((debug error) 
+           (setq error err)))
+      (let ((result (cond (ok `(:ok ,value))
+                          (error `(:error ,(symbol-name (car error))
+                                          . ,(mapcar #'prin1-to-string 
+                                                     (cdr error))))
+                          (t `(:abort)))))
         (slime-dispatch-event `(:emacs-return ,thread ,tag ,result) c)))))
 
+(defun slime-check-eval-in-emacs-result (x)
+  "Raise an error if X can't be marshaled."
+  (or (stringp x)
+      (memq x '(nil t))
+      (integerp x)
+      (keywordp x)
+      (and (consp x)
+           (let ((l x))
+             (while (consp l)
+               (slime-check-eval-in-emacs-result (car x))
+               (setq l (cdr l)))
+             (slime-check-eval-in-emacs-result l)))
+      (error "Non-serializable return value: %S" x)))
+
 (defun slime-check-eval-in-emacs-enabled ()
   "Raise an error if `slime-enable-evaluate-in-emacs' isn't true."
   (unless slime-enable-evaluate-in-emacs
--- /project/slime/cvsroot/slime/swank.lisp	2011/02/02 11:12:33	1.738
+++ /project/slime/cvsroot/slime/swank.lisp	2011/02/04 14:26:36	1.739
@@ -1818,14 +1818,6 @@
     (number (let ((*print-base* 10))
               (princ-to-string form)))))
 
-(defstruct (unreadable-object
-             (:print-object
-              (lambda (object stream)
-                (print-unreadable-object (object stream :type t :identity t)
-                  (princ (unreadable-object-string object)
-                         stream)))))
-  string)
-
 (defun eval-in-emacs (form &optional nowait)
   "Eval FORM in Emacs.
 `slime-enable-evaluate-in-emacs' should be set to T on the Emacs side."
@@ -1838,9 +1830,8 @@
 				  ,(process-form-for-emacs form)))
 	   (let ((value (caddr (wait-for-event `(:emacs-return ,tag result)))))
 	     (destructure-case value
-	       ((:ok value)
-                (handler-case (values (read-from-string value))
-                  (reader-error () (make-unreadable-object :string value))))
+	       ((:ok value) value)
+               ((:error kind . data) (error "~a: ~{~a~}" kind data))
 	       ((:abort) (abort))))))))
 
 (defvar *swank-wire-protocol-version* nil