[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Sat Dec 10 12:33:52 UTC 2011
Update of /project/slime/cvsroot/slime
In directory tiger.common-lisp.net:/tmp/cvs-serv29633
Modified Files:
ChangeLog swank.lisp
Log Message:
* swank.lisp: Move global io-redirection contrib/slime-repl.lisp.
--- /project/slime/cvsroot/slime/ChangeLog 2011/12/10 12:33:40 1.2283
+++ /project/slime/cvsroot/slime/ChangeLog 2011/12/10 12:33:52 1.2284
@@ -1,5 +1,9 @@
2011-12-10 Helmut Eller <heller at common-lisp.net>
+ * swank.lisp: Move global io-redirection contrib/slime-repl.lisp.
+
+2011-12-10 Helmut Eller <heller at common-lisp.net>
+
Make *active-threads* a slot of the connection struct.
* swank.lisp (*active-threads*): Deleted
--- /project/slime/cvsroot/slime/swank.lisp 2011/12/10 12:33:40 1.778
+++ /project/slime/cvsroot/slime/swank.lisp 2011/12/10 12:33:52 1.779
@@ -205,7 +205,7 @@
(user-output nil :type (or stream null))
(user-io nil :type (or stream null))
;; Bindings used for this connection (usually streams)
- env
+ (env '() :type list)
;; 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.
@@ -1294,157 +1294,6 @@
(end-of-file () (error 'end-of-repl-input :stream stream)))))
-;; FIXME: would be nice if we could move this I/O stuff to swank-repl.lisp.
-
-;;;; IO to Emacs
-;;;
-;;; This code handles redirection of the standard I/O streams
-;;; (`*standard-output*', etc) into Emacs. The `connection' structure
-;;; contains the appropriate streams, so all we have to do is make the
-;;; right bindings.
-
-;;;;; Global I/O redirection framework
-;;;
-;;; Optionally, the top-level global bindings of the standard streams
-;;; can be assigned to be redirected to Emacs. When Emacs connects we
-;;; redirect the streams into the connection, and they keep going into
-;;; that connection even if more are established. If the connection
-;;; handling the streams closes then another is chosen, or if there
-;;; are no connections then we revert to the original (real) streams.
-;;;
-;;; It is slightly tricky to assign the global values of standard
-;;; streams because they are often shadowed by dynamic bindings. We
-;;; solve this problem by introducing an extra indirection via synonym
-;;; streams, so that *STANDARD-INPUT* is a synonym stream to
-;;; *CURRENT-STANDARD-INPUT*, etc. We never shadow the "current"
-;;; variables, so they can always be assigned to affect a global
-;;; change.
-
-(defvar *globally-redirect-io* nil
- "When non-nil globally redirect all standard streams to Emacs.")
-
-;;;;; Global redirection setup
-
-(defvar *saved-global-streams* '()
- "A plist to save and restore redirected stream objects.
-E.g. the value for '*standard-output* holds the stream object
-for *standard-output* before we install our redirection.")
-
-(defun setup-stream-indirection (stream-var &optional stream)
- "Setup redirection scaffolding for a global stream variable.
-Supposing (for example) STREAM-VAR is *STANDARD-INPUT*, this macro:
-
-1. Saves the value of *STANDARD-INPUT* in `*SAVED-GLOBAL-STREAMS*'.
-
-2. Creates *CURRENT-STANDARD-INPUT*, initially with the same value as
-*STANDARD-INPUT*.
-
-3. Assigns *STANDARD-INPUT* to a synonym stream pointing to
-*CURRENT-STANDARD-INPUT*.
-
-This has the effect of making *CURRENT-STANDARD-INPUT* contain the
-effective global value for *STANDARD-INPUT*. This way we can assign
-the effective global value even when *STANDARD-INPUT* is shadowed by a
-dynamic binding."
- (let ((current-stream-var (prefixed-var '#:current stream-var))
- (stream (or stream (symbol-value stream-var))))
- ;; Save the real stream value for the future.
- (setf (getf *saved-global-streams* stream-var) stream)
- ;; Define a new variable for the effective stream.
- ;; This can be reassigned.
- (proclaim `(special ,current-stream-var))
- (set current-stream-var stream)
- ;; Assign the real binding as a synonym for the current one.
- (let ((stream (make-synonym-stream current-stream-var)))
- (set stream-var stream)
- (set-default-initial-binding stream-var `(quote ,stream)))))
-
-(defun prefixed-var (prefix variable-symbol)
- "(PREFIXED-VAR \"FOO\" '*BAR*) => SWANK::*FOO-BAR*"
- (let ((basename (subseq (symbol-name variable-symbol) 1)))
- (intern (format nil "*~A-~A" (string prefix) basename) :swank)))
-
-(defvar *standard-output-streams*
- '(*standard-output* *error-output* *trace-output*)
- "The symbols naming standard output streams.")
-
-(defvar *standard-input-streams*
- '(*standard-input*)
- "The symbols naming standard input streams.")
-
-(defvar *standard-io-streams*
- '(*debug-io* *query-io* *terminal-io*)
- "The symbols naming standard io streams.")
-
-(defun init-global-stream-redirection ()
- (when *globally-redirect-io*
- (cond (*saved-global-streams*
- (warn "Streams already redirected."))
- (t
- (mapc #'setup-stream-indirection
- (append *standard-output-streams*
- *standard-input-streams*
- *standard-io-streams*))))))
-
-(add-hook *after-init-hook* 'init-global-stream-redirection)
-
-(defun globally-redirect-io-to-connection (connection)
- "Set the standard I/O streams to redirect to CONNECTION.
-Assigns *CURRENT-<STREAM>* for all standard streams."
- (dolist (o *standard-output-streams*)
- (set (prefixed-var '#:current o)
- (connection.user-output connection)))
- ;; FIXME: If we redirect standard input to Emacs then we get the
- ;; regular Lisp top-level trying to read from our REPL.
- ;;
- ;; Perhaps the ideal would be for the real top-level to run in a
- ;; thread with local bindings for all the standard streams. Failing
- ;; that we probably would like to inhibit it from reading while
- ;; Emacs is connected.
- ;;
- ;; Meanwhile we just leave *standard-input* alone.
- #+NIL
- (dolist (i *standard-input-streams*)
- (set (prefixed-var '#:current i)
- (connection.user-input connection)))
- (dolist (io *standard-io-streams*)
- (set (prefixed-var '#:current io)
- (connection.user-io connection))))
-
-(defun revert-global-io-redirection ()
- "Set *CURRENT-<STREAM>* to *REAL-<STREAM>* for all standard streams."
- (dolist (stream-var (append *standard-output-streams*
- *standard-input-streams*
- *standard-io-streams*))
- (set (prefixed-var '#:current stream-var)
- (getf *saved-global-streams* stream-var))))
-
-;;;;; Global redirection hooks
-
-(defvar *global-stdio-connection* nil
- "The connection to which standard I/O streams are globally redirected.
-NIL if streams are not globally redirected.")
-
-(defun maybe-redirect-global-io (connection)
- "Consider globally redirecting to CONNECTION."
- (when (and *globally-redirect-io* (null *global-stdio-connection*)
- (connection.user-io connection))
- (setq *global-stdio-connection* connection)
- (globally-redirect-io-to-connection connection)))
-
-(defun update-redirection-after-close (closed-connection)
- "Update redirection after a connection closes."
- (check-type closed-connection connection)
- (when (eq *global-stdio-connection* closed-connection)
- (if (and (default-connection) *globally-redirect-io*)
- ;; Redirect to another connection.
- (globally-redirect-io-to-connection (default-connection))
- ;; No more connections, revert to the real streams.
- (progn (revert-global-io-redirection)
- (setq *global-stdio-connection* nil)))))
-
-(add-hook *connection-closed-hook* 'update-redirection-after-close)
-
;;; Channels
;; FIXME: should be per connection not global.
More information about the slime-cvs
mailing list