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

Diff of /slime/swank-clisp.lisp

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

revision 1.4 by wjenkner, Fri Jan 9 02:26:10 2004 UTC revision 1.5 by vsedach, Mon Jan 12 05:05:04 2004 UTC
# Line 24  Line 24 
24    (use-package "SOCKET")    (use-package "SOCKET")
25    (use-package "GRAY"))    (use-package "GRAY"))
26    
27  ;(setq *use-dedicated-output-stream* nil)  (setq *use-dedicated-output-stream* nil)
28  (setq *start-swank-in-background* nil)  (setq *start-swank-in-background* nil)
29  ;(setq *redirect-output* nil)  ;(setq *redirect-output* nil)
30    
# Line 79  Line 79 
79    
80  ;;; TCP Server  ;;; TCP Server
81    
82   (defun get-socket-stream (port announce close-socket-p)  (defmethod create-socket-server (init-fn &key announce-fn (port 0)
83     (let ((socket (socket:socket-server port)))                                           (accept-background nil)
84       (socket:socket-wait socket 0)                                           (handle-background nil)
85       (funcall announce (socket:socket-server-port socket))                                           (loop nil)
86       (prog1                                           (reuse-address nil))
87          (socket:socket-accept socket    (declare (ignore loop reuse-address accept-background handle-background))
88                                :buffered nil    (let* ((slime-stream (get-socket-stream port announce-fn))
89                                :element-type 'character           (handler-fn (funcall init-fn slime-stream)))
90                                :external-format (ext:make-encoding        (loop (funcall handler-fn))))
91                                                  :charset 'charset:iso-8859-1  
92                                                  :line-terminator :unix))  (defun get-socket-stream (port announce)
93          (when close-socket-p    (let ((socket (socket:socket-server port)))
           (socket:socket-server-close socket)))))  
   
 (defun serve-request (*emacs-io* *slime-output* *slime-input* *slime-io*)  
   "Read and process a request from a SWANK client.  
  The request is read from the socket as a sexp and then evaluated."  
   (catch 'slime-toplevel  
     (with-simple-restart (abort "Return to Slime toplevel.")  
     (handler-case (read-from-emacs)  
                   (ext:simple-charset-type-error (err)  
                                                  (format *debug-io* "Wrong slime stream encoding:~%~A" err))  
                   (slime-read-error (e)  
                                     (when *swank-debug-p*  
                                       (format *debug-io* "~&;; Connection to Emacs lost.~%;; [~A]~%" e))  
                                     (close *emacs-io* :abort t)  
                                     (when *use-dedicated-output-stream*  
                                       (close *slime-output* :abort t))  
                                     (throw 'closed-connection  
                                            (print "Connection to emacs closed" *debug-io*)))))))  
   
 (defun open-stream-to-emacs (*emacs-io*)  
   "Return an output-stream to Emacs' output buffer."  
   (let* ((listener (socket:socket-server))  
          (port (socket:socket-server-port listener)))  
94      (unwind-protect      (unwind-protect
95          (prog2          (progn
96              (eval-in-emacs `(slime-open-stream-to-lisp ,port))            (funcall announce (socket:socket-server-port socket))
97              (socket:socket-accept listener            (socket:socket-wait socket 0)
98                                    :buffered t            (socket:socket-accept socket
99                                    :external-format charset:iso-8859-1                                  :buffered nil
100                                    :element-type 'character))                                  :element-type 'character
101        (socket:socket-server-close listener))))                                  :external-format (ext:make-encoding
102                                                      :charset 'charset:iso-8859-1
103  (defun create-swank-server (port &key (announce #'simple-announce-function)                                                    :line-terminator :unix)))
104                                   reuse-address        (socket:socket-server-close socket))))
105                                   background  
106                                   (close *close-swank-socket-after-setup*))  (defmethod make-fn-streams (input-fn output-fn)
107    (declare (ignore reuse-address background))    (let* ((output (make-instance 'slime-output-stream
108    (let* ((emacs (get-socket-stream port announce close))                                  :output-fn output-fn))
109           (slime-out (if *use-dedicated-output-stream*           (input  (make-instance 'slime-input-stream
110                          (open-stream-to-emacs emacs)                                  :input-fn input-fn
111                        (make-instance 'slime-output-stream)))                                  :output-stream output)))
112           (slime-in (make-instance 'slime-input-stream))      (values input output)))
          (slime-io (make-two-way-stream slime-in slime-out)))  
     (catch 'closed-connection  
       (loop (serve-request emacs slime-out slime-in slime-io)))))  
113    
114  ;;; Swank functions  ;;; Swank functions
115    

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

  ViewVC Help
Powered by ViewVC 1.1.5