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

[Helmut Eller]

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

Modified Files:
	swank.lisp 
Log Message:
(*pending-continuations*, eval-in-emacs, debugger-info-for-emacs):
Keep track of debugged continuation the new variable
*pending-continuations* and include the list of active continuations
in the debugger info for Emacs.

(eval-and-grab-output): New function.  Used by slime-eval-print.

(*log-output*): Renamed from *log-io*.  Use *standard-error* as
initial value instead of *terminal-io*.  CMUCL opens its own tty and
that makes it hard to redirect to output with a shell.
*standard-error* writes its output to file descriptor 2.

(*canonical-package-nicknames*): Fix typo.

Date: Thu Jan 27 11:56:06 2005
Author: heller

Index: slime/swank.lisp
diff -u slime/swank.lisp:1.277 slime/swank.lisp:1.278
--- slime/swank.lisp:1.277	Thu Jan 20 12:02:32 2005
+++ slime/swank.lisp	Thu Jan 27 11:56:06 2005
@@ -63,7 +63,7 @@
 (defconstant keyword-package (find-package :keyword)
   "The KEYWORD package.")
 
-(defvar *canonical-packge-nicknames*
+(defvar *canonical-package-nicknames*
   '(("COMMON-LISP-USER" . "CL-USER"))
   "Canonical package names to use instead of shortest name/nickname.")
 
@@ -276,14 +276,14 @@
        (delete-package ,var))))
 
 (defvar *log-events* nil)
-(defvar *log-io* *terminal-io*)
+(defvar *log-output* *error-output*)
 
 (defun log-event (format-string &rest args)
   "Write a message to *terminal-io* when *log-events* is non-nil.
 Useful for low level debugging."
   (when *log-events*
-    (apply #'format *log-io* format-string args)
-    (force-output *log-io*)))
+    (apply #'format *log-output* format-string args)
+    (force-output *log-output*)))
 
 ;;;; TCP Server
 
@@ -1249,6 +1249,9 @@
 
 ;;;; Evaluation
 
+(defvar *pending-continuations* '()
+  "List of continuations for Emacs. (thread local)")
+
 (defun eval-in-emacs (form)
   "Execute FORM in Emacs."
   (destructuring-bind (fn &rest args) form
@@ -1268,7 +1271,8 @@
     (let (ok result)
       (unwind-protect
            (let ((*buffer-package* (guess-buffer-package buffer-package))
-                 (*buffer-readtable* (guess-buffer-readtable buffer-package)))
+                 (*buffer-readtable* (guess-buffer-readtable buffer-package))
+                 (*pending-continuations* (cons id *pending-continuations*)))
              (assert (packagep *buffer-package*))
              (assert (readtablep *buffer-readtable*))
              (setq result (eval form))
@@ -1296,6 +1300,14 @@
       (force-output)
       (format-values-for-echo-area values))))
 
+(defslimefun eval-and-grab-output (string)
+  (with-buffer-syntax ()
+    (let* ((s (make-string-output-stream))
+           (*standard-output* s)
+           (values (multiple-value-list (eval (read-from-string string)))))
+      (list (get-output-stream-string s) 
+            (format nil "~{~S~^~%~}" values)))))
+
 (defun eval-region (string &optional package-update-p)
   "Evaluate STRING and return the result.
 If PACKAGE-UPDATE-P is non-nil, and evaluation causes a package
@@ -1325,10 +1337,13 @@
 
 (defun canonical-package-nickname (package)
   "Return the canonical package nickname, if any, of PACKAGE."
-  (cdr (assoc (package-name package) *canonical-packge-nicknames* :test #'string=)))
+  (cdr (assoc (package-name package) *canonical-package-nicknames* 
+              :test #'string=)))
 
 (defun auto-abbreviated-package-name (package)
-  "Return an abbreviated 'name' for PACKAGE. N.B. this is not an actual package name or nickname."
+  "Return an abbreviated 'name' for PACKAGE. 
+
+N.B. this is not an actual package name or nickname."
   (when *auto-abbreviate-dotted-packages*
     (let ((last-dot (position #\. (package-name package) :from-end t)))
       (when last-dot (subseq (package-name package) (1+ last-dot))))))
@@ -1587,12 +1602,13 @@
 (defslimefun debugger-info-for-emacs (start end)
   "Return debugger state, with stack frames from START to END.
 The result is a list:
-  (condition ({restart}*) ({stack-frame}*)
+  (condition ({restart}*) ({stack-frame}*) (cont*))
 where
   condition   ::= (description type [extra])
   restart     ::= (name description)
   stack-frame ::= (number description)
-  extra       ::= (:references 
+  extra       ::= (:references and other random things)
+  cont        ::= continutation
 condition---a pair of strings: message, and type.  If show-source is
 not nil it is a frame number for which the source should be displayed.
 
@@ -1601,6 +1617,8 @@
 stack-frame---a number from zero (the top), and a printed
 representation of the frame's call.
 
+continutation---the id of a pending Emacs continuation.
+
 Below is an example return value. In this case the condition was a
 division by zero (multi-line description), and only one frame is being
 fetched (start=0, end=1).
@@ -1610,10 +1628,12 @@
    \"[Condition of type DIVISION-BY-ZERO]\")
   ((\"ABORT\" \"Return to Slime toplevel.\")
    (\"ABORT\" \"Return to Top-Level.\"))
-  ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\")))"
+  ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\"))
+  (4))"
   (list (debugger-condition-for-emacs)
 	(format-restarts-for-emacs)
-	(backtrace start end)))
+	(backtrace start end)
+        *pending-continuations*))
 
 (defun nth-restart (index)
   (nth index *sldb-restarts*))