[slime-cvs] CVS slime
CVS User heller
heller at common-lisp.net
Wed Dec 24 07:56:20 UTC 2008
Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv13718
Modified Files:
ChangeLog slime.el swank-backend.lisp swank-cmucl.lisp
swank.lisp
Log Message:
Create a repl also for *communication-style* = nil.
Use a custom stream which processes SLIME requests while waiting for
input.
* slime.el (slime-set-connection-info): Don't create a repl
buffer.
(slime-start-lisp): Bind process-connection-type to nil to avoid
problems witht CLISPs readline code.
* swank.lisp (read-non-blocking, make-repl-input-stream)
(simple-repl): New functions.
(simple-serve-requests): Use it.
* swank-backend.lisp (wait-for-one-stream, wait-for-streams): New
functions.
(wait-for-input): Use it to support wainting on multiple streams.
* swank-cmucl.lisp (to-fd-stream): New function.
(wait-for-input): Use it.
--- /project/slime/cvsroot/slime/ChangeLog 2008/12/23 08:33:11 1.1600
+++ /project/slime/cvsroot/slime/ChangeLog 2008/12/24 07:56:20 1.1601
@@ -1,5 +1,23 @@
2008-12-23 Helmut Eller <heller at common-lisp.net>
+ * slime.el (slime-set-connection-info): Don't create a repl
+ buffer.
+ (slime-start-lisp): Bind process-connection-type to nil to avoid
+ problems witht CLISPs readline code.
+
+ * swank.lisp (read-non-blocking, make-repl-input-stream)
+ (simple-repl): New functions.
+ (simple-serve-requests): Use it.
+
+ * swank-backend.lisp (wait-for-one-stream, wait-for-streams): New
+ functions.
+ (wait-for-input): Use it to support wainting on multiple streams.
+
+ * swank-cmucl.lisp (to-fd-stream): New function.
+ (wait-for-input): Use it.
+
+2008-12-23 Helmut Eller <heller at common-lisp.net>
+
* slime.el (slime-run-mode-hooks): Wrapper for Emacs21.
(slime-repl-mode): Use it.
Reported by Peter Denno.
--- /project/slime/cvsroot/slime/slime.el 2008/12/23 08:33:12 1.1077
+++ /project/slime/cvsroot/slime/slime.el 2008/12/24 07:56:20 1.1078
@@ -1387,7 +1387,8 @@
(when directory
(cd (expand-file-name directory)))
(comint-mode)
- (let ((process-environment (append env process-environment)))
+ (let ((process-environment (append env process-environment))
+ (process-connection-type nil))
(comint-exec (current-buffer) "inferior-lisp" program nil program-args))
(lisp-mode-variables t)
(let ((proc (get-buffer-process (current-buffer))))
@@ -2086,8 +2087,8 @@
(unless (string= (slime-lisp-implementation-name) name)
(setf (slime-connection-name)
(slime-generate-connection-name (symbol-name name)))))
- (slime-hide-inferior-lisp-buffer)
- (slime-init-output-buffer connection)
+ ;;(slime-hide-inferior-lisp-buffer)
+ ;;(slime-init-output-buffer connection)
(slime-load-contribs)
(run-hooks 'slime-connected-hook)
(when-let (fun (plist-get args ':init-function))
--- /project/slime/cvsroot/slime/swank-backend.lisp 2008/11/02 12:05:13 1.163
+++ /project/slime/cvsroot/slime/swank-backend.lisp 2008/12/24 07:56:20 1.164
@@ -1065,25 +1065,37 @@
return nil.
Return :interrupt if an interrupt occurs while waiting."
- (assert (= (length streams) 1))
- (let ((stream (car streams)))
- (case timeout
- ((nil)
- (cond ((check-slime-interrupts) :interrupt)
- (t (peek-char nil stream nil nil)
- streams)))
- ((t)
- (let ((c (read-char-no-hang stream nil nil)))
- (cond (c
- (unread-char c stream)
- streams)
- (t '()))))
- (t
- (loop
- (if (check-slime-interrupts) (return :interrupt))
- (when (wait-for-input streams t) (return streams))
- (sleep 0.1)
- (when (<= (decf timeout 0.1) 0) (return nil)))))))
+ (assert (member timeout '(nil t)))
+ (cond ((null (cdr streams))
+ (wait-for-one-stream (car streams) timeout))
+ (t
+ (wait-for-streams streams timeout))))
+
+(defun wait-for-streams (streams timeout)
+ (flet ((readyp (s)
+ (let ((c (read-char-no-hang s nil :eof)))
+ (or (eq c :eof)
+ (and c (progn (unread-char c s) t))
+ c))))
+ (loop
+ (let ((ready (remove-if-not #'readyp streams)))
+ (when ready (return ready)))
+ (when timeout (return nil))
+ (when (check-slime-interrupts) (return :interrupt))
+ (sleep 0.1))))
+
+(defun wait-for-one-stream (stream timeout)
+ (ecase timeout
+ ((nil)
+ (cond ((check-slime-interrupts) :interrupt)
+ (t (peek-char nil stream nil nil)
+ (list stream))))
+ ((t)
+ (let ((c (read-char-no-hang stream nil nil)))
+ (cond (c
+ (unread-char c stream)
+ (list stream))
+ (t '()))))))
(definterface toggle-trace (spec)
"Toggle tracing of the function(s) given with SPEC.
--- /project/slime/cvsroot/slime/swank-cmucl.lisp 2008/11/02 12:05:13 1.203
+++ /project/slime/cvsroot/slime/swank-cmucl.lisp 2008/12/24 07:56:20 1.204
@@ -200,7 +200,7 @@
(when timeout (return nil))
(multiple-value-bind (in out) (make-pipe)
(let* ((f (constantly t))
- (handlers (loop for s in (cons in streams)
+ (handlers (loop for s in (cons in (mapcar #'to-fd-stream streams))
collect (add-one-shot-handler s f))))
(unwind-protect
(handler-bind ((slime-interrupt-queued
@@ -211,6 +211,15 @@
(close in)
(close out))))))
+(defun to-fd-stream (stream)
+ (etypecase stream
+ (sys:fd-stream stream)
+ (synonym-stream
+ (to-fd-stream
+ (symbol-value (synonym-stream-symbol stream))))
+ (two-way-stream
+ (to-fd-stream (two-way-stream-input-stream stream)))))
+
(defun add-one-shot-handler (stream function)
(let (handler)
(setq handler (sys:add-fd-handler (sys:fd-stream-fd stream) :input
--- /project/slime/cvsroot/slime/swank.lisp 2008/12/23 08:33:03 1.613
+++ /project/slime/cvsroot/slime/swank.lisp 2008/12/24 07:56:20 1.614
@@ -493,12 +493,24 @@
(defvar *log-output* nil) ; should be nil for image dumpers
(defun init-log-output ()
- (labels ((deref (x)
- (cond ((typep x 'synonym-stream)
- (deref (symbol-value (synonym-stream-symbol x))))
- (t x))))
- (unless *log-output*
- (setq *log-output* (deref *error-output*)))))
+ (unless *log-output*
+ (setq *log-output* (real-output-stream *error-output*))))
+
+(defun real-input-stream (stream)
+ (typecase stream
+ (synonym-stream
+ (real-input-stream (symbol-value (synonym-stream-symbol stream))))
+ (two-way-stream
+ (real-input-stream (two-way-stream-input-stream stream)))
+ (t stream)))
+
+(defun real-output-stream (stream)
+ (typecase stream
+ (synonym-stream
+ (real-output-stream (symbol-value (synonym-stream-symbol stream))))
+ (two-way-stream
+ (real-output-stream (two-way-stream-output-stream stream)))
+ (t stream)))
(add-hook *after-init-hook* 'init-log-output)
@@ -1261,9 +1273,49 @@
(invoke-or-queue-interrupt #'dispatch-interrupt-event))
(lambda ()
(with-simple-restart (close-connection "Close SLIME connection")
- (handle-requests connection))))
+ ;;(handle-requests connection)
+ (let* ((stdin (real-input-stream *standard-input*))
+ (*standard-input* (make-repl-input-stream connection
+ stdin)))
+ (simple-repl)))))
(close-connection connection nil (safe-backtrace))))
+(defun simple-repl ()
+ (loop
+ (with-simple-restart (abort "Abort")
+ (format t "~&~a> " (package-string-for-prompt *package*))
+ (force-output)
+ (let ((form (read)))
+ (fresh-line)
+ (let ((- form)
+ (values (multiple-value-list (eval form))))
+ (setq *** ** ** * * (car values)
+ /// // // / / values
+ +++ ++ ++ + + form)
+ (cond ((null values) (format t "~&; No values"))
+ (t (mapc (lambda (v) (format t "~&~s" v)) values))))))))
+
+(defun make-repl-input-stream (connection stdin)
+ (make-input-stream
+ (lambda ()
+ (loop
+ (let* ((socket (connection.socket-io connection))
+ (inputs (list socket stdin))
+ (ready (wait-for-input inputs)))
+ (cond ((eq ready :interrupt)
+ (check-slime-interrupts))
+ ((member socket ready)
+ (handle-requests connection t))
+ ((member stdin ready)
+ (return (read-non-blocking stdin)))
+ (t (assert (null ready)))))))))
+
+(defun read-non-blocking (stream)
+ (with-output-to-string (str)
+ (loop (let ((c (read-char-no-hang stream)))
+ (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)
More information about the slime-cvs
mailing list