/[slime]/slime/swank-sbcl.lisp
ViewVC logotype

Diff of /slime/swank-sbcl.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.28 by dbarlow, Tue Nov 25 00:23:27 2003 UTC revision 1.29 by heller, Fri Nov 28 12:10:41 2003 UTC
# Line 62  Line 62 
62    
63  ;;; TCP Server  ;;; TCP Server
64    
65    (defun open-listener (port reuse-address)
 (defun create-swank-server (port &key reuse-address)  
   "Create a SWANK TCP server."  
66    (let ((socket (make-instance 'sb-bsd-sockets:inet-socket    (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
67                                 :type :stream                                 :type :stream
68                                 :protocol :tcp)))                                 :protocol :tcp)))
# Line 73  Line 71 
71      (setf (sb-bsd-sockets:non-blocking-mode socket) t)      (setf (sb-bsd-sockets:non-blocking-mode socket) t)
72      (sb-bsd-sockets:socket-bind socket #(127 0 0 1) port)      (sb-bsd-sockets:socket-bind socket #(127 0 0 1) port)
73      (sb-bsd-sockets:socket-listen socket 5)      (sb-bsd-sockets:socket-listen socket 5)
74        socket))
75    
76    (defun accept (socket)
77      "Like socket-accept, but retry on EAGAIN."
78      (loop (handler-case
79                (return (sb-bsd-sockets:socket-accept socket))
80              (sb-bsd-sockets:interrupted-error ()))))
81    
82    (defun create-swank-server (port &key reuse-address)
83      "Create a SWANK TCP server."
84      (let ((socket (open-listener port reuse-address)))
85      (sb-sys:add-fd-handler      (sb-sys:add-fd-handler
86       (sb-bsd-sockets:socket-file-descriptor socket)       (sb-bsd-sockets:socket-file-descriptor socket)
87       :input (lambda (fd)       :input (lambda (fd)
# Line 80  Line 89 
89                (accept-connection socket)))                (accept-connection socket)))
90      (nth-value 1 (sb-bsd-sockets:socket-name socket))))      (nth-value 1 (sb-bsd-sockets:socket-name socket))))
91    
92    (defun open-stream-to-emacs ()
93      (let* ((server-socket (open-listener 0 t))
94             (port (nth-value 1 (sb-bsd-sockets:socket-name server-socket))))
95        (unwind-protect
96             (progn
97               (eval-in-emacs `(slime-open-stream-to-lisp ,port))
98               (let ((socket (accept server-socket)))
99                 (sb-bsd-sockets:socket-make-stream
100                  socket :output t :element-type 'base-char)))
101          (sb-bsd-sockets:socket-close server-socket))))
102    
103    (defvar *use-dedicated-output-stream* t)
104    
105  (defun accept-connection (server-socket)  (defun accept-connection (server-socket)
106    "Accept one Swank TCP connection on SOCKET and then close it."    "Accept one Swank TCP connection on SOCKET and then close it."
107    (let* ((socket (sb-bsd-sockets:socket-accept server-socket))    (let* ((socket (accept server-socket))
108           (stream (sb-bsd-sockets:socket-make-stream           (stream (sb-bsd-sockets:socket-make-stream
109                    socket :input t :output t :element-type 'base-char))                    socket :input t :output t :element-type 'base-char))
110           (out (make-instance 'slime-output-stream))           (out (if *use-dedicated-output-stream*
111                      (let ((*emacs-io* stream)) (open-stream-to-emacs))
112                      (make-instance 'slime-output-stream)))
113           (in (make-instance 'slime-input-stream))           (in (make-instance 'slime-input-stream))
114           (io (make-two-way-stream in out)))           (io (make-two-way-stream in out)))
115      (sb-sys:invalidate-descriptor (sb-bsd-sockets:socket-file-descriptor      (sb-sys:invalidate-descriptor (sb-bsd-sockets:socket-file-descriptor
# Line 97  Line 121 
121                (declare (ignore fd))                (declare (ignore fd))
122                (serve-request stream out in io)))))                (serve-request stream out in io)))))
123    
124    
125  (defun serve-request (*emacs-io* *slime-output* *slime-input* *slime-io*)  (defun serve-request (*emacs-io* *slime-output* *slime-input* *slime-io*)
126    "Read and process a request from a SWANK client.    "Read and process a request from a SWANK client.
127  The request is read from the socket as a sexp and then evaluated."  The request is read from the socket as a sexp and then evaluated."

Legend:
Removed from v.1.28  
changed lines
  Added in v.1.29

  ViewVC Help
Powered by ViewVC 1.1.5