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

Diff of /slime/swank.lisp

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

revision 1.100 by heller, Fri Jan 16 07:26:13 2004 UTC revision 1.101 by heller, Fri Jan 16 21:28:59 2004 UTC
# Line 136  Only this thread can read from or send i Line 136  Only this thread can read from or send i
136  ;; This can't be initialized right away due to our compilation/loading  ;; This can't be initialized right away due to our compilation/loading
137  ;; order: it ends up calling the NO-APPLICABLE-METHOD version from  ;; order: it ends up calling the NO-APPLICABLE-METHOD version from
138  ;; swank-backend before the real one loads.  ;; swank-backend before the real one loads.
139  (makunbound  (defvar *write-lock*)
140   (defvar *write-lock* nil  (setf (documentation '*write-lock* 'variable)
141     "Lock held while writing to sockets."))        "Lock held while writing to sockets.")
142    
143  (defvar *dispatching-connection* nil  (defvar *dispatching-connection* nil
144    "Connection currently being served.    "Connection currently being served.
# Line 175  If *REDIRECT-IO* is true, all standard I Line 175  If *REDIRECT-IO* is true, all standard I
175  (defvar *use-dedicated-output-stream* t)  (defvar *use-dedicated-output-stream* t)
176  (defvar *swank-in-background* nil)  (defvar *swank-in-background* nil)
177    
178  (defun start-server (port-file)  (defun start-server (port-file &optional (background *swank-in-background*))
179      (setup-server 0 (lambda (port) (announce-server-port port-file port))
180                    background))
181    
182    (defun create-swank-server (&optional (port 4005)
183                                (background *swank-in-background*))
184      (setup-server port #'simple-announce-function background))
185    
186    (defun setup-server (port announce-fn background)
187    (setq *write-lock* (make-lock :name "Swank write lock"))    (setq *write-lock* (make-lock :name "Swank write lock"))
188    (if (eq *swank-in-background* :spawn)    (if (eq *swank-in-background* :spawn)
189        (spawn (lambda () (setup-server port-file nil))        (spawn (lambda () (open-swank-socket port announce-fn nil))
190               :name "Swank")               :name "Swank")
191        (setup-server port-file *swank-in-background*)))        (open-swank-socket port announce-fn background)))
192    
193  (defun setup-server (port-file background)  (defun open-swank-socket (port announce-fn background)
194    (let ((socket (create-socket 0)))    (let ((socket (create-socket port)))
195      (announce-server-port port-file (local-port socket))      (funcall announce-fn (local-port socket))
196      (let ((client (accept-connection socket)))      (let ((client (accept-connection socket)))
197        (close-socket socket)        (close-socket socket)
198        (let ((connection (create-connection client)))        (let ((connection (create-connection client)))
# Line 221  If *REDIRECT-IO* is true, all standard I Line 229  If *REDIRECT-IO* is true, all standard I
229        (make-output-function socket-io)        (make-output-function socket-io)
230      (let ((input-fn  (lambda () (read-user-input-from-emacs socket-io))))      (let ((input-fn  (lambda () (read-user-input-from-emacs socket-io))))
231        (multiple-value-bind (in out) (make-fn-streams input-fn output-fn)        (multiple-value-bind (in out) (make-fn-streams input-fn output-fn)
232          (let ((io (make-two-way-stream in out)))          (let ((out (or dedicated-output out)))
233            (make-connection (thread-id) socket-io dedicated-output            (let ((io (make-two-way-stream in out)))
234                             in out io))))))              (make-connection (thread-id) socket-io dedicated-output
235                                 in out io)))))))
236    
237  (defun make-output-function (socket-io)  (defun make-output-function (socket-io)
238    "Create function to send user output to Emacs.    "Create function to send user output to Emacs.

Legend:
Removed from v.1.100  
changed lines
  Added in v.1.101

  ViewVC Help
Powered by ViewVC 1.1.5