[slime-cvs] CVS update: slime/swank.lisp slime/swank-cmucl.lisp slime/slime.el
Luke Gorrie
lgorrie at common-lisp.net
Mon Oct 27 04:04:56 UTC 2003
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv5112
Modified Files:
Tag: backhackattack-1
swank.lisp swank-cmucl.lisp slime.el
Log Message:
(on bighackattack-1 branch)
Took a step towards refactoring the backends, working on just the
CMUCL one to begin with. The backend is now split into a separate
package, so that all necessary symbols are explicit.
Major major hackage, but the test suite passes for CMUCL.
Have not made any actual improvements yet - except for adding
asynchronous evaluation, which I should have committed before the
hackage that lead to the branch.
"Won't stay branched for long!"
Date: Sun Oct 26 23:04:56 2003
Author: lgorrie
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.45 slime/swank.lisp:1.45.2.1
--- slime/swank.lisp:1.45 Fri Oct 24 21:54:00 2003
+++ slime/swank.lisp Sun Oct 26 23:04:56 2003
@@ -1,6 +1,6 @@
-;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
-;;;
-;;; swank.lisp --- the portable bits
+;;;; -*- mode: lisp; mode: outline-minor; outline-regexp: ";;;;;*"; indent-tabs-mode: nil -*-
+
+;;;; swank.lisp --- the portable bits
;;;
;;; Created 2003, Daniel Barlow <dan at metacircles.com>
;;;
@@ -11,10 +11,64 @@
(defpackage :swank
(:use :common-lisp)
(:nicknames "SWANK-IMPL")
- (:export #:start-server)))
+ (:export
+
+ ;;-- Emacs entry-points
+ #:start-server
+ #:eval-string #:oneway-eval-string
+ #:interactive-eval #:interactive-eval-region
+ #:re-evaluate-defvar
+ #:pprint-eval
+ #:set-package
+ #:features
+ #:compiler-notes-for-file
+ #:compiler-notes-for-emacs
+ #:list-all-package-names
+ #:take-input
+
+ ;;-- Callbacks for the backend to implement.
+ #:create-swank-server
+ #:call-trapping-compilation-notes
+ #:call-with-debugging-environment
+ #:swank-compile-file #:swank-compile-string
+ #:arglist-string
+ #:who-calls #:who-references #:who-binds
+ #:who-sets #:who-macroexpands
+ #:list-callers #:list-callees
+ #:function-source-location-for-emacs
+ #:frame-source-location-for-emacs
+ #:eval-string-in-frame
+ #:frame-locals #:frame-catch-tags
+ #:invoke-nth-restart #:sldb-continue #:sldb-abort
+ #:throw-to-toplevel
+ #:describe-setf-function #:describe-type #:describe-class
+ #:swank-macroexpand-all
+ #:toggle-trace-fdefinition
+ #:getpid
+ #:backtrace-for-emacs #:debugger-info-for-emacs
+ #:set-default-directory
+ #:init-inspector
+ #:inspect-nth-part
+ #:inspector-pop
+ #:inspector-next
+ #:quit-inspector
+ #:describe-inspectee
+
+ ;;-- Library for backend to call
+ #:read-from-emacs #:send-to-emacs
+ #:*swank-debugger-condition* #:*sldb-level* #:*swank-debugger-hook*
+ #:*swank-debug-p*
+
+ #:*buffer-package* #:*compiler-notes* #:*notes-database* #:*previous-compiler-condition* #:*previous-context* #:*sldb-level* #:*swank-debugger-condition*
+ #:apply-macro-expander #:backtrace-for-emacs #:call-with-compilation-hooks #:clear-note-database #:from-string #:print-description-to-string #:to-string
+
+ #:*emacs-io* #:*slime-output* #:*slime-input* #:*slime-io*
+ )))
(in-package :swank)
+
+;;;; Global variables
(defvar *swank-io-package*
(let ((package (make-package "SWANK-IO-PACKAGE")))
(import '(nil t quote) package)
@@ -28,12 +82,73 @@
(defvar *swank-debug-p* t
"When true, print extra debugging information.")
+(defparameter callbacks '()
+ "List of callback functions to be implemented by backends.")
+
+(defmacro defcallback (name arglist docstring)
+ `(defun ,name (&rest args)
+ ,docstring
+ (declare (ignore args))
+ (format t "BAD CALLBACK: ~S" ',name)))
+
+
+;;;; Callback functions for the backend.
+
+(defcallback create-swank-server (port &key reuse-address address)
+ "Create a Swank TCP server to accept a single connection.
+Returns the port number the connection is actually listening on.")
+(defcallback swank-compile-file (filename loadp)
+ "Compile FILENAME. If LOADP is non-nil, load it afterwards.")
+(defcallback swank-compile-string (string buffer start)
+ "Compile STRING.
+BUFFER and START indicate the position in Emacs that STRING comes from.")
+(defcallback call-trapping-compilation-notes (function)
+ "Call FUNCTION, and record any resulting compilation notes.")
+(defcallback arglist-string (function-name)
+ "Return a string describing FUNCTION-NAME's argument list.")
+(defcallback who-calls (symbol) "")
+(defcallback who-references (symbol) "")
+(defcallback who-binds (symbol) "")
+(defcallback who-sets (symbol) "")
+(defcallback who-macroexpands (symbol) "")
+(defcallback list-callers (symbol-name) "") ; FIXME: s/symbol-name/symbol/
+(defcallback list-callees (symbol-name) "")
+(defcallback function-source-location-for-emacs (&rest _) "")
+(defcallback frame-source-location-for-emacs (&rest _) "")
+(defcallback eval-string-in-frame (&rest _) "")
+(defcallback frame-locals (&rest _) "")
+(defcallback frame-catch-tags (&rest _) "")
+(defcallback invoke-nth-restart (&rest _) "")
+(defcallback sldb-continue (&rest _) "")
+(defcallback sldb-abort (&rest _) "")
+(defcallback throw-to-toplevel (&rest _) "")
+(defcallback describe-setf-function (&rest _) "")
+(defcallback describe-type (&rest _) "")
+(defcallback describe-class (&rest _) "")
+(defcallback swank-macroexpand-all (&rest _) "")
+(defcallback toggle-trace-fdefinition (&rest _) "")
+(defcallback getpid (&rest _) "")
+(defcallback backtrace-for-emacs (&rest _) "")
+(defcallback debugger-info-for-emacs (&rest _) "")
+(defcallback set-default-directory (&rest _) "")
+(defcallback init-inspector (&rest _) "")
+(defcallback inspector-pop (&rest _) "")
+(defcallback inspector-next (&rest _) "")
+(defcallback quit-inspector (&rest _) "")
+(defcallback describe-inspectee (&rest _) "")
+
+;;; These variables are always bound when debugger callbacks are made.
+
+(defvar *swank-debugger-condition*)
+(defvar *swank-debugger-hook*)
+(defvar *sldb-level* 0)
+
;;; Setup and Hooks
-(defun start-server (port-file-namestring)
+(defun start-server (port-file-namestring &optional (port 0))
"Create a SWANK server and write its port number to the file
PORT-FILE-NAMESTRING in ascii text."
- (let ((port (create-swank-server 0 :reuse-address t)))
+ (let ((port (create-swank-server port :reuse-address t)))
(with-open-file (s port-file-namestring
:direction :output
:if-exists :overwrite
@@ -42,6 +157,37 @@
(when *swank-debug-p*
(format *debug-io* "~&;; Swank ready.~%")))
+(defcallback call-with-debugging-environment (function)
+ "Execute FUNCTION in an environment setup for debugging.
+Calls to backend debugger callbacks will be made from the dynamic
+environment created by this function.")
+
+(define-condition swank-debug-condition (serious-condition)
+ ((wrapped-condition :initarg :wrapped-condition
+ :reader wrapped-condition)))
+
+(defun swank-debugger-hook (condition hook)
+ (let ((*swank-debugger-condition* condition)
+ (*swank-debugger-hook* hook)
+ (*sldb-level* (1+ *sldb-level*)))
+ (call-with-debugging-environment #'sldb-loop)))
+
+(defun sldb-loop ()
+ (let ((level *sldb-level*))
+ (send-to-emacs (list* :debug *sldb-level* (debugger-info-for-emacs 0 1)))
+ (handler-bind ((swank-debug-condition
+ (lambda (condition)
+ (let ((real-condition (wrapped-condition condition)))
+ (send-to-emacs `(:debug-condition
+ ,(princ-to-string real-condition))))
+ (throw 'sldb-loop-catcher nil))))
+ (unwind-protect
+ (loop (catch 'sldb-loop-catcher
+ (with-simple-restart
+ (abort "Return to sldb level ~D." level)
+ (read-from-emacs))))
+ (send-to-emacs `(:debug-return ,level))))))
+
;;; IO to emacs
(defvar *emacs-io* nil
@@ -60,7 +206,9 @@
(defun read-from-emacs ()
"Read and process a request from Emacs."
+ (format t "~&Reading request.~%")
(let ((form (read-next-form)))
+ (format t "~&Form = ~S~%" form)
(if *redirect-output*
(let ((*standard-output* *slime-output*)
(*error-output* *slime-output*)
@@ -76,15 +224,17 @@
S-expression to be evaluated to handle the request. If an error
occurs during parsing, it will be noted and control will be tranferred
back to the main request handling loop."
+ (format t "~&READ-NEXT-FORM 1~%")
(flet ((next-byte () (char-code (read-char *emacs-io*))))
(handler-case
(let* ((length (logior (ash (next-byte) 16)
(ash (next-byte) 8)
(next-byte)))
(string (make-string length)))
+ (format t "~&READ-NEXT-FORM 2~%")
(read-sequence string *emacs-io*)
(read-form string))
- (condition (c)
+ (serious-condition (c)
(throw 'serve-request-catcher c)))))
(defun read-form (string)
@@ -151,14 +301,6 @@
(error "Backend function ~A not implemented." ',fun))
(export ',fun :swank)))
-(defvar *swank-debugger-condition*)
-(defvar *swank-debugger-hook*)
-
-(defun swank-debugger-hook (condition hook)
- (let ((*swank-debugger-condition* condition)
- (*swank-debugger-hook* hook))
- (sldb-loop)))
-
(defslimefun eval-string (string buffer-package)
(let ((*debugger-hook* #'swank-debugger-hook))
(let (ok result)
@@ -169,6 +311,10 @@
(force-output)
(setq ok t))
(send-to-emacs (if ok `(:ok ,result) '(:aborted)))))))
+
+(defslimefun oneway-eval-string (string buffer-package)
+ (let ((*buffer-package* (guess-package-from-string buffer-package)))
+ (eval (read-form string))))
(defslimefun interactive-eval (string)
(let ((values (multiple-value-list (eval (from-string string)))))
Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.12 slime/swank-cmucl.lisp:1.12.2.1
--- slime/swank-cmucl.lisp:1.12 Fri Oct 24 21:54:00 2003
+++ slime/swank-cmucl.lisp Sun Oct 26 23:04:56 2003
@@ -1,7 +1,22 @@
(declaim (optimize debug))
-(in-package :swank)
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (defpackage :swank-cmucl
+ (:use :common-lisp)
+ (:nicknames "SWANK-BACKEND")))
+
+(in-package :swank-cmucl)
+
+(import '(swank:*swank-debugger-condition* swank:*sldb-level*
+swank:*buffer-package* swank:*compiler-notes* swank:*notes-database*
+swank:*previous-compiler-condition* swank:*previous-context*
+swank:*sldb-level* swank:*swank-debugger-condition*
+swank:apply-macro-expander swank:backtrace-for-emacs
+swank:call-with-compilation-hooks swank:clear-note-database
+swank:from-string swank:print-description-to-string swank:to-string
+swank:*emacs-io* swank:*slime-output* swank:*slime-input* swank:*slime-io*))
+
;;; Setup and hooks.
@@ -29,7 +44,7 @@
(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)))))
+ (swank:send-to-emacs `(:read-output ,(get-output-stream-string stream)))))
(:file-position nil)
(:charpos
(do ((index (1- (the fixnum (lisp::string-output-stream-index stream)))
@@ -57,19 +72,20 @@
(defun slime-input-stream/n-bin (stream buffer start requested eof-errorp)
(let ((*read-input-catch-tag* (1+ *read-input-catch-tag*)))
- (send-to-emacs `(:read-input ,requested ,*read-input-catch-tag*))
+ (swank:send-to-emacs `(:read-input ,requested ,*read-input-catch-tag*))
(let ((input (catch *read-input-catch-tag*
- (read-from-emacs))))
+ (swank:read-from-emacs))))
(loop for c across input
for i from start
do (setf (aref buffer i) (char-code c)))
(length input))))
-(defslimefun take-input (tag input)
+(defun swank:take-input (tag input)
(throw tag input))
-(defun create-swank-server (port &key reuse-address (address "localhost"))
+(defun swank:create-swank-server (port &key reuse-address (address "localhost"))
"Create a SWANK TCP server."
+ (dribble "/tmp/swank.log")
(let* ((hostent (ext:lookup-host-entry address))
(address (car (ext:host-entry-addr-list hostent)))
(ip (ext:htonl address)))
@@ -103,10 +119,10 @@
The request is read from the socket as a sexp and then evaluated."
(let ((completed nil))
(let ((condition (catch 'serve-request-catcher
- (read-from-emacs)
+ (swank:read-from-emacs)
(setq completed t))))
(unless completed
- (when *swank-debug-p*
+ (when swank:*swank-debug-p*
(format *debug-io*
"~&;; Connection to Emacs lost.~%;; [~A]~%" condition))
(sys:invalidate-descriptor (sys:fd-stream-fd *emacs-io*))
@@ -114,7 +130,7 @@
;;;
-(defslimefun set-default-directory (directory)
+(defun swank:set-default-directory (directory)
(setf (ext:default-directory) (namestring directory))
;; Setting *default-pathname-defaults* to an absolute directory
;; makes the behavior of MERGE-PATHNAMES a bit more intuitive.
@@ -198,13 +214,13 @@
(reverse
(c::compiler-error-context-original-source-path context)))))
-(defun call-trapping-compilation-notes (fn)
+(defun swank:call-trapping-compilation-notes (fn)
(handler-bind ((c::compiler-error #'handle-notification-condition)
(c::style-warning #'handle-notification-condition)
(c::warning #'handle-notification-condition))
(funcall fn)))
-(defslimefun swank-compile-file (filename load)
+(defun swank:swank-compile-file (filename load)
(call-with-compilation-hooks
(lambda ()
(clear-note-database filename)
@@ -213,7 +229,7 @@
(*buffer-offset* nil))
(compile-file filename :load load)))))
-(defslimefun swank-compile-string (string buffer start)
+(defun swank:swank-compile-string (string buffer start)
(call-with-compilation-hooks
(lambda ()
(let ((*package* *buffer-package*)
@@ -254,14 +270,14 @@
(defun unix-truename (pathname)
(ext:unix-namestring (truename pathname)))
-(defslimefun arglist-string (fname)
+(defun swank:arglist-string (fname)
"Return a string describing the argument list for FNAME.
The result has the format \"(...)\"."
(declare (type string fname))
(multiple-value-bind (function condition)
(ignore-errors (values (from-string fname)))
(when condition
- (return-from arglist-string (format nil "(-- ~A)" condition)))
+ (return-from swank:arglist-string (format nil "(-- ~A)" condition)))
(let ((arglist
(if (not (or (fboundp function)
(functionp function)))
@@ -287,24 +303,24 @@
arglist
(to-string arglist)))))
-(defslimefun who-calls (function-name)
+(defun swank:who-calls (function-name)
"Return the places where FUNCTION-NAME is called."
(xref-results-for-emacs (xref:who-calls function-name)))
-(defslimefun who-references (variable)
+(defun swank:who-references (variable)
"Return the places where the global variable VARIABLE is referenced."
(xref-results-for-emacs (xref:who-references variable)))
-(defslimefun who-binds (variable)
+(defun swank:who-binds (variable)
"Return the places where the global variable VARIABLE is bound."
(xref-results-for-emacs (xref:who-binds variable)))
-(defslimefun who-sets (variable)
+(defun swank:who-sets (variable)
"Return the places where the global variable VARIABLE is set."
(xref-results-for-emacs (xref:who-sets variable)))
#+cmu19
-(defslimefun who-macroexpands (macro)
+(defun swank:who-macroexpands (macro)
"Return the places where MACRO is expanded."
(xref-results-for-emacs (xref:who-macroexpands macro)))
@@ -421,10 +437,10 @@
(let ((*print-pretty* nil))
(mapcar #'to-string (remove-if-not #'ext:valid-function-name-p list))))
-(defslimefun list-callers (symbol-name)
+(defun swank:list-callers (symbol-name)
(stringify-function-name-list (function-callers (from-string symbol-name))))
-(defslimefun list-callees (symbol-name)
+(defun swank:list-callees (symbol-name)
(stringify-function-name-list (function-callees (from-string symbol-name))))
;;;; Definitions
@@ -492,7 +508,7 @@
(when location
(source-location-for-emacs location))))))
-(defslimefun function-source-location-for-emacs (fname)
+(defun swank:function-source-location-for-emacs (fname)
"Return the source-location of FNAME's definition."
(let* ((fname (from-string fname))
(finder
@@ -545,21 +561,21 @@
(if result
(list* :designator (to-string symbol) result)))))
-(defslimefun describe-setf-function (symbol-name)
+(defun swank:describe-setf-function (symbol-name)
(print-description-to-string
(or (ext:info setf inverse (from-string symbol-name))
(ext:info setf expander (from-string symbol-name)))))
-(defslimefun describe-type (symbol-name)
+(defun swank:describe-type (symbol-name)
(print-description-to-string
(kernel:values-specifier-type (from-string symbol-name))))
-(defslimefun describe-class (symbol-name)
+(defun swank:describe-class (symbol-name)
(print-description-to-string (find-class (from-string symbol-name) nil)))
;;; Macroexpansion
-(defslimefun swank-macroexpand-all (string)
+(defun swank:swank-macroexpand-all (string)
(apply-macro-expander #'walker:macroexpand-all string))
@@ -569,7 +585,7 @@
(gethash (debug::trace-fdefinition fname)
debug::*traced-functions*))
-(defslimefun toggle-trace-fdefinition (fname-string)
+(defun swank:toggle-trace-fdefinition (fname-string)
(let ((fname (from-string fname-string)))
(cond ((tracedp fname)
(debug::untrace-1 fname)
@@ -581,14 +597,28 @@
;;; Debugging
-(defvar *sldb-level* 0)
(defvar *sldb-stack-top*)
(defvar *sldb-restarts*)
-(defslimefun getpid ()
+(defun swank:getpid ()
(unix:unix-getpid))
-(defslimefun sldb-loop ()
+(defun swank:call-with-debugging-environment (function)
+ (unix:unix-sigsetmask 0)
+ (let ((*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
+ (*sldb-restarts* (compute-restarts swank:*swank-debugger-condition*))
+ (debug:*stack-top-hint* nil)
+ (*readtable* (or debug:*debug-readtable* *readtable*))
+ (*print-level* debug:*debug-print-level*)
+ (*print-length* debug:*debug-print-length*))
+ (handler-bind ((di:debug-condition
+ (lambda (condition)
+ (signal 'swank-debug-condition
+ :wrapped-condition condition))))
+ (funcall function))))
+
+#+nil
+(defun swank:sldb-loop ()
(unix:unix-sigsetmask 0)
(let* ((*sldb-level* (1+ *sldb-level*))
(*sldb-stack-top* (or debug:*stack-top-hint* (di:top-frame)))
@@ -600,18 +630,19 @@
(*readtable* (or debug:*debug-readtable* *readtable*))
(*print-level* debug:*debug-print-level*)
(*print-length* debug:*debug-print-length*))
- (send-to-emacs (list* :debug *sldb-level* (debugger-info-for-emacs 0 1)))
+ (swank:send-to-emacs
+ (list* :debug *sldb-level* (debugger-info-for-emacs 0 1)))
(handler-bind ((di:debug-condition
(lambda (condition)
- (send-to-emacs `(:debug-condition
+ (swank:send-to-emacs `(:debug-condition
,(princ-to-string condition)))
(throw 'sldb-loop-catcher nil))))
(unwind-protect
(loop
(catch 'sldb-loop-catcher
(with-simple-restart (abort "Return to sldb level ~D." level)
- (read-from-emacs))))
- (send-to-emacs `(:debug-return ,level))))))
+ (swank:read-from-emacs))))
+ (swank:send-to-emacs `(:debug-return ,level))))))
(defun format-restarts-for-emacs ()
"Return a list of restarts for *swank-debugger-condition* in a
@@ -631,7 +662,12 @@
((zerop i) frame)))
(defun nth-restart (index)
- (nth index *sldb-restarts*))
+ (or (nth index *sldb-restarts*)
+ (signal 'swank-debug-condition
+ :wrapped-condition
+ (make-condition 'simple-condition
+ :format-control "Restart out of bounds: ~S"
+ :format-arguments (list index)))))
(defun format-frame-for-emacs (frame)
(list (di:frame-number frame)
@@ -655,10 +691,10 @@
while f
collect f)))
-(defslimefun backtrace-for-emacs (start end)
+(defun swank:backtrace-for-emacs (start end)
(mapcar #'format-frame-for-emacs (compute-backtrace start end)))
-(defslimefun debugger-info-for-emacs (start end)
+(defun swank:debugger-info-for-emacs (start end)
(list (format-condition-for-emacs)
(format-restarts-for-emacs)
(backtrace-length)
@@ -716,13 +752,13 @@
(handler-case (source-location-for-emacs code-location)
(t (c) (list :error (debug::safe-condition-message c)))))
-(defslimefun frame-source-location-for-emacs (index)
+(defun swank:frame-source-location-for-emacs (index)
(safe-source-location-for-emacs (di:frame-code-location (nth-frame index))))
-(defslimefun eval-string-in-frame (string index)
+(defun swank:eval-string-in-frame (string index)
(to-string (di:eval-in-frame (nth-frame index) (from-string string))))
-(defslimefun frame-locals (index)
+(defun swank:frame-locals (index)
(let* ((frame (nth-frame index))
(location (di:frame-code-location frame))
(debug-function (di:frame-debug-function frame))
@@ -738,20 +774,21 @@
(to-string (di:debug-variable-value v frame))
"<not-available>")))))
-(defslimefun frame-catch-tags (index)
+(defun swank:frame-catch-tags (index)
(loop for (tag . code-location) in (di:frame-catches (nth-frame index))
collect `(,tag . ,(safe-source-location-for-emacs code-location))))
-(defslimefun invoke-nth-restart (index)
- (invoke-restart (nth-restart index)))
+(defun swank:invoke-nth-restart (sldb-level index)
+ (when (eql sldb-level *sldb-level*)
+ (invoke-restart (nth-restart index))))
-(defslimefun sldb-continue ()
+(defun swank:sldb-continue ()
(continue *swank-debugger-condition*))
-(defslimefun sldb-abort ()
+(defun swank:sldb-abort ()
(invoke-restart (find 'abort *sldb-restarts* :key #'restart-name)))
-(defslimefun throw-to-toplevel ()
+(defun swank:throw-to-toplevel ()
(throw 'lisp::top-level-catcher nil))
@@ -769,7 +806,7 @@
(setq *inspector-stack* nil)
(setf (fill-pointer *inspector-history*) 0))
-(defslimefun init-inspector (string)
+(defun swank:init-inspector (string)
(reset-inspector)
(inspect-object (eval (from-string string))))
@@ -836,10 +873,10 @@
(defun nth-part (index)
(cdr (nth index *inspectee-parts*)))
-(defslimefun inspect-nth-part (index)
+(defun swank:inspect-nth-part (index)
(inspect-object (nth-part index)))
-(defslimefun inspector-pop ()
+(defun swank:inspector-pop ()
"Drop the inspector stack and inspect the second element. Return
nil if there's no second element."
(cond ((cdr *inspector-stack*)
@@ -847,18 +884,18 @@
(inspect-object (pop *inspector-stack*)))
(t nil)))
-(defslimefun inspector-next ()
+(defun swank:inspector-next ()
"Inspect the next element in the *inspector-history*."
(let ((position (position *inspectee* *inspector-history*)))
(cond ((= (1+ position) (length *inspector-history*))
nil)
(t (inspect-object (aref *inspector-history* (1+ position)))))))
-(defslimefun quit-inspector ()
+(defun swank:quit-inspector ()
(reset-inspector)
nil)
-(defslimefun describe-inspectee ()
+(defun swank:describe-inspectee ()
"Describe the currently inspected object."
(print-description-to-string *inspectee*))
Index: slime/slime.el
diff -u slime/slime.el:1.59 slime/slime.el:1.59.2.1
--- slime/slime.el:1.59 Fri Oct 24 21:54:00 2003
+++ slime/slime.el Sun Oct 26 23:04:56 2003
@@ -992,7 +992,9 @@
(assert (= sldb-level 0)))
((:emacs-evaluate form-string package-name continuation)
(slime-output-evaluate-request form-string package-name)
- (slime-push-state (slime-evaluating-state continuation))))
+ (slime-push-state (slime-evaluating-state continuation)))
+ ((:emacs-evaluate-oneway form-string package-name)
+ (slime-output-oneway-evaluate-request form-string package-name)))
(defvar slime-evaluating-state-activation-hook nil
"Hook called when the evaluating state is actived.")
@@ -1056,10 +1058,14 @@
(delete-windows-on sldb-buffer)
(kill-buffer sldb-buffer))))
(slime-pop-state))
+ ((:debug-condition reason)
+ (message reason))
((:emacs-evaluate form-string package-name continuation)
;; recursive evaluation request
(slime-output-evaluate-request form-string package-name)
- (slime-push-state (slime-evaluating-state continuation))))
+ (slime-push-state (slime-evaluating-state continuation)))
+ ((:emacs-evaluate-oneway form-string package-name)
+ (slime-output-oneway-evaluate-request form-string package-name)))
(slime-defstate slime-read-input-state (request tag)
"Reading state.
@@ -1080,6 +1086,10 @@
"Send a request for LISP to read and evaluate FORM-STRING in PACKAGE-NAME."
(slime-net-send `(swank:eval-string ,form-string ,package-name)))
+(defun slime-output-oneway-evaluate-request (form-string package-name)
+ "Send a request for LISP to read and evaluate FORM-STRING in PACKAGE-NAME."
+ (slime-net-send `(swank:oneway-eval-string ,form-string ,package-name)))
+
(defun slime-check-connected ()
(unless (slime-connected-p)
(error "Not connected. Use `M-x slime' to start a Lisp.")))
@@ -1137,6 +1147,14 @@
(while (slime-busy-p)
(accept-process-output slime-net-process)))
+(defun slime-oneway-eval (sexp &optional package)
+ "Evaluate SEXP \"one-way\" - without receiving a return value."
+ (slime-check-connected)
+ (when (slime-busy-p)
+ (error "Busy evaluating"))
+ (slime-dispatch-event
+ `(:emacs-evaluate-oneway ,(prin1-to-string sexp) ,package)))
+
(defun slime-busy-p ()
"Return true if Lisp is busy processing a request."
(eq (slime-state-name (slime-current-state)) 'slime-evaluating-state))
@@ -2700,7 +2718,7 @@
(let ((restart (or number
(sldb-restart-at-point)
(error "No restart at point"))))
- (slime-eval-async `(swank:invoke-nth-restart ,restart) nil (lambda ()))))
+ (slime-oneway-eval `(swank:invoke-nth-restart ,sldb-level ,restart) nil)))
(defun sldb-restart-at-point ()
(get-text-property (point) 'restart-number))
More information about the slime-cvs
mailing list