/[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.5 by lgorrie, Thu Oct 16 20:05:21 2003 UTC revision 1.6 by dbarlow, Fri Oct 17 01:38:41 2003 UTC
# Line 31  Line 31 
31  ;;; * Cross-referencing (nor is it likely, absent XREF port to SBCL)  ;;; * Cross-referencing (nor is it likely, absent XREF port to SBCL)
32  ;;; * testsuite can't find LOOP, reports bogus failure on some arglist lookups  ;;; * testsuite can't find LOOP, reports bogus failure on some arglist lookups
33  ;;; * eval-in-frame  ;;; * eval-in-frame
 ;;; * M-. has an off-by-two (character positions) error  
34  ;;; * A slime command to load an asdf system.  Note that this might involve  ;;; * A slime command to load an asdf system.  Note that this might involve
35  ;;;    compiling/loading files that Emacs has no buffers for  ;;;    compiling/loading files that Emacs has no buffers for
36  ;;; * Dealing with multiple threads  ;;; * Dealing with multiple threads
# Line 50  Line 49 
49    
50  ;;; TCP Server  ;;; TCP Server
51    
52    
53    (defun create-swank-server (port &key reuse-address)
54      "Create a SWANK TCP server."
55      (let ((socket (make-instance 'sb-bsd-sockets:inet-socket
56                                   :type :stream
57                                   :protocol :tcp)))
58        (when reuse-address
59          (setf (sb-bsd-sockets:sockopt-reuse-address socket) t))
60        (setf (sb-bsd-sockets:non-blocking-mode socket) t)
61        (sb-bsd-sockets:socket-bind socket #(127 0 0 1) port)
62        (sb-bsd-sockets:socket-listen socket 5)
63        (sb-sys:add-fd-handler
64         (sb-bsd-sockets:socket-file-descriptor socket)
65         :input (lambda (fd)
66                  (declare (ignore fd))
67                  (accept-connection socket)))))
68    
69    (defun accept-connection (server-socket)
70      "Accept a SWANK TCP connection on SOCKET."
71      (let* ((socket (sb-bsd-sockets:socket-accept server-socket))
72             (stream (sb-bsd-sockets:socket-make-stream
73                      socket :input t :output t :element-type 'unsigned-byte)))
74        (sb-sys:add-fd-handler
75         (sb-bsd-sockets:socket-file-descriptor socket)
76         :input (lambda (fd)
77                  (declare (ignore fd))
78                  (serve-request stream)))))
79    
80    (defun serve-request (*emacs-io*)
81      "Read and process a request from a SWANK client.
82    The request is read from the socket as a sexp and then evaluated."
83      (let* ((completed nil)
84             (*slime-output* (make-instance 'slime-output-stream)))
85        (let ((condition (catch 'serve-request-catcher
86                           (read-from-emacs)
87                           (setq completed t))))
88          (unless completed
89            (when *swank-debug-p*
90              (format *debug-io*
91                      "~&;; Connection to Emacs lost.~%;; [~A]~%" condition))
92            (sb-sys:invalidate-descriptor (sb-sys:fd-stream-fd *emacs-io*))
93            (close *emacs-io*)))))
94    
95    
96    #|
97    
98  ;; The Swank backend runs in a separate thread and simply blocks on  ;; The Swank backend runs in a separate thread and simply blocks on
99  ;; its TCP port while waiting for forms to evaluate.  ;; its TCP port while waiting for forms to evaluate.
100    
# Line 109  until the remote Emacs goes away." Line 154  until the remote Emacs goes away."
154                      (return))))))))                      (return))))))))
155      (format *terminal-io* "~&;; Swank: Closed connection: ~A~%" *emacs-io*)      (format *terminal-io* "~&;; Swank: Closed connection: ~A~%" *emacs-io*)
156      (close *emacs-io*)))      (close *emacs-io*)))
157    |#
158    
159    
160    
161  ;;; Redirecting Output to Emacs  ;;; Redirecting Output to Emacs
162    

Legend:
Removed from v.1.5  
changed lines
  Added in v.1.6

  ViewVC Help
Powered by ViewVC 1.1.5