[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Wed Dec 24 08:14:06 UTC 2008
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv27040
Modified Files:
ChangeLog slime.el swank.lisp
Log Message:
* swank.lisp (connection.env): New slot. To hold dynamic variable
bindings for this connection.
(with-io-redirection): Use it.
(create-repl): New function. Currently only redirects IO for the
connection. Could potentially be used to create multiple
listeners, each with a set of streams and corresponding buffers.
(*redirect-io*, maybe-call-with-io-redirection)
(call-with-redirected-io): Deleted.
* slime-repl.el (slime-repl-connected-hook-function): Create
a repl at startup. Well, initialize stream redirection.
--- /project/slime/cvsroot/slime/ChangeLog 2008/12/24 08:06:25 1.1602
+++ /project/slime/cvsroot/slime/ChangeLog 2008/12/24 08:14:06 1.1603
@@ -1,5 +1,16 @@
2008-12-23 Helmut Eller <heller at common-lisp.net>
+ * swank.lisp (connection.env): New slot. To hold dynamic variable
+ bindings for this connection.
+ (with-io-redirection): Use it.
+ (create-repl): New function. Currently only redirects IO for the
+ connection. Could potentially be used to create multiple
+ listeners, each with a set of streams and corresponding buffers.
+ (*redirect-io*, maybe-call-with-io-redirection)
+ (call-with-redirected-io): Deleted.
+
+2008-12-23 Helmut Eller <heller at common-lisp.net>
+
Move most of the REPL mode to contrib.
Disable some commands that depend on the
existence of a REPL buffer.
--- /project/slime/cvsroot/slime/slime.el 2008/12/24 08:06:25 1.1079
+++ /project/slime/cvsroot/slime/slime.el 2008/12/24 08:14:06 1.1080
@@ -2336,8 +2336,6 @@
(let ((slime-dispatching-connection (or process (slime-connection))))
(or (run-hook-with-args-until-success 'slime-event-hooks event)
(destructure-case event
- ;;((:write-string output &optional target)
- ;; (slime-write-string output target))
((:emacs-rex form package thread continuation)
(when (and (slime-use-sigint-for-interrupt) (slime-busy-p))
(slime-display-oneliner "; pipelined request... %S" form))
@@ -2364,14 +2362,8 @@
(sldb-exit thread level stepping))
((:emacs-interrupt thread)
(slime-send `(:emacs-interrupt ,thread)))
-;; ((:read-string thread tag)
-;; (assert thread)
-;; (slime-repl-read-string thread tag))
((:y-or-n-p thread tag question)
(slime-y-or-n-p thread tag question))
-;; ((:read-aborted thread tag)
-;; (assert thread)
-;; (slime-repl-abort-read thread tag))
((:emacs-return-string thread tag string)
(slime-send `(:emacs-return-string ,thread ,tag ,string)))
;;
@@ -2382,8 +2374,6 @@
(setf (slime-lisp-features) features))
((:indentation-update info)
(slime-handle-indentation-update info))
- ;;((:open-dedicated-output-stream port)
- ;; (slime-open-stream-to-lisp port))
((:eval-no-wait fun args)
(apply (intern fun) args))
((:eval thread tag form-string)
--- /project/slime/cvsroot/slime/swank.lisp 2008/12/24 07:56:20 1.614
+++ /project/slime/cvsroot/slime/swank.lisp 2008/12/24 08:14:06 1.615
@@ -90,10 +90,6 @@
(defvar *swank-debug-p* t
"When true, print extra debugging information.")
-(defvar *redirect-io* t
- "When non-nil redirect Lisp standard I/O to Emacs.
-Redirection is done while Lisp is processing a request for Emacs.")
-
(defvar *sldb-printer-bindings*
`((*print-pretty* . t)
(*print-level* . 4)
@@ -226,6 +222,8 @@
(user-input nil :type (or stream null))
(user-output nil :type (or stream null))
(user-io nil :type (or stream null))
+ ;; Bindings used for this connection (usually streams)
+ env
;; A stream that we use for *trace-output*; if nil, we user user-output.
(trace-output nil :type (or stream null))
;; A stream where we send REPL results.
@@ -391,14 +389,9 @@
(symbol (apply #'make-condition datum args))))
(defmacro with-io-redirection ((connection) &body body)
- "Execute BODY I/O redirection to CONNECTION.
-If *REDIRECT-IO* is true then all standard I/O streams are redirected."
- `(maybe-call-with-io-redirection ,connection (lambda () , at body)))
-
-(defun maybe-call-with-io-redirection (connection fun)
- (if *redirect-io*
- (call-with-redirected-io connection fun)
- (funcall fun)))
+ "Execute BODY I/O redirection to CONNECTION. "
+ `(with-bindings (connection.env ,connection)
+ . ,body))
(defmacro with-connection ((connection) &body body)
"Execute BODY in the context of CONNECTION."
@@ -1202,7 +1195,6 @@
(defun control-thread (connection)
(with-struct* (connection. @ connection)
(setf (@ control-thread) (current-thread))
- (setf (@ repl-thread) (spawn-repl-thread connection "repl-thread"))
(setf (@ reader-thread) (spawn (lambda () (read-loop connection))
:name "reader-thread"))
(dispatch-loop connection)))
@@ -1316,16 +1308,6 @@
(unless c (return))
(write-char c str)))))
-(defun initialize-streams-for-connection (connection)
- (multiple-value-bind (dedicated in out io repl-results)
- (open-streams connection)
- (setf (connection.dedicated-output connection) dedicated
- (connection.user-io connection) io
- (connection.user-output connection) out
- (connection.user-input connection) in
- (connection.repl-results connection) repl-results)
- connection))
-
(defun create-connection (socket-io style)
(let ((success nil))
(unwind-protect
@@ -1347,7 +1329,6 @@
:serve-requests #'simple-serve-requests))
)))
(setf (connection.communication-style c) style)
- (initialize-streams-for-connection c)
(setf success t)
c)
(unless success
@@ -1504,21 +1485,32 @@
;;; We always redirect the standard streams to Emacs while evaluating
;;; an RPC. This is done with simple dynamic bindings.
-(defun call-with-redirected-io (connection function)
- "Call FUNCTION with I/O streams redirected via CONNECTION."
- (declare (type function function))
- (let* ((io (connection.user-io connection))
- (in (connection.user-input connection))
- (out (connection.user-output connection))
- (trace (or (connection.trace-output connection) out))
- (*standard-output* out)
- (*error-output* out)
- (*trace-output* trace)
- (*debug-io* io)
- (*query-io* io)
- (*standard-input* in)
- (*terminal-io* io))
- (funcall function)))
+(defslimefun create-repl (target)
+ (assert (eq target nil))
+ (let ((conn *emacs-connection*))
+ (initialize-streams-for-connection conn)
+ (with-struct* (connection. @ conn)
+ (setf (@ env)
+ `((*standard-output* . ,(@ user-output))
+ (*standard-input* . ,(@ user-input))
+ (*trace-output* . ,(or (@ trace-output) (@ user-output)))
+ (*error-output* . ,(@ user-output))
+ (*debug-io* . ,(@ user-io))
+ (*query-io* . ,(@ user-io))
+ (*terminal-io* . ,(@ user-io))))
+ (when (eq (@ communication-style) :spawn)
+ (setf (@ repl-thread) (spawn-repl-thread conn "repl-thread")))
+ t)))
+
+(defun initialize-streams-for-connection (connection)
+ (multiple-value-bind (dedicated in out io repl-results)
+ (open-streams connection)
+ (setf (connection.dedicated-output connection) dedicated
+ (connection.user-io connection) io
+ (connection.user-output connection) out
+ (connection.user-input connection) in
+ (connection.repl-results connection) repl-results)
+ connection))
(defun call-with-thread-description (description thunk)
;; For `M-x slime-list-threads': Display what threads
@@ -1537,6 +1529,9 @@
(unwind-protect (funcall thunk)
(set-thread-description thread old-description)))))
+
+
+
(defmacro with-thread-description (description &body body)
`(call-with-thread-description ,description #'(lambda () , at body)))
More information about the slime-cvs
mailing list