/[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.7 by lgorrie, Tue Jan 13 04:23:12 2004 UTC revision 1.8 by heller, Tue Jan 13 18:20:04 2004 UTC
# Line 43  Line 43 
43  (defun without-interrupts* (fun)  (defun without-interrupts* (fun)
44    (without-interrupts (funcall fun)))    (without-interrupts (funcall fun)))
45    
 #+linux (defslimefun getpid () (linux::getpid))  
46  #+unix (defslimefun getpid () (system::program-id))  #+unix (defslimefun getpid () (system::program-id))
47  #+win32 (defslimefun getpid () (or (system::getenv "PID") -1))  #+win32 (defslimefun getpid () (or (system::getenv "PID") -1))
48  ;; the above is likely broken; we need windows NT users!  ;; the above is likely broken; we need windows NT users!
49    
50    
51  ;;; Gray streams  ;;; TCP Server
   
 ;; From swank-gray.lisp.  
   
 (defclass slime-input-stream (fundamental-character-input-stream)  
   ((buffer :initform "") (index :initform 0)))  
   
 ;; We have to define an additional method for the sake of the C  
 ;; function listen_char (see src/stream.d), on which SYS::READ-FORM  
 ;; depends.  
   
 ;; We could make do with either of the two methods below.  
   
 (defmethod stream-read-char-no-hang ((s slime-input-stream))  
   (with-slots (buffer index) s  
     (when (< index (length buffer))  
       (prog1 (aref buffer index) (incf index)))))  
   
 ;; This CLISP extension is what listen_char actually calls.  The  
 ;; default method would call STREAM-READ-CHAR-NO-HANG, so it is a bit  
 ;; more efficient to define it directly.  
52    
53  (defmethod stream-read-char-will-hang-p ((s slime-input-stream))  (defmethod create-socket (port)
54    (with-slots (buffer index) s    (socket:socket-server port))
     (= index (length buffer))))  
55    
56    (defmethod local-port (socket)
57  ;;; TCP Server    (socket:socket-server-port socket))
58    
59  (defmethod accept-socket/stream (&key (port 0) announce-fn)  (defmethod close-socket (socket)
60    (get-socket-stream port announce-fn))    (socket:socket-server-close socket))
61    
62  (defmethod accept-socket/run (&key (port 0) announce-fn init-fn)  (defmethod accept-connection (socket)
63    (let* ((slime-stream (get-socket-stream port announce-fn))    (socket:socket-wait socket)
64           (handler-fn (funcall init-fn slime-stream)))    (socket:socket-accept socket
65      (loop while t do (funcall handler-fn))))                          :buffered nil ;; XXX should be t
66                            :element-type 'character
67  (defun get-socket-stream (port announce)                          :external-format (ext:make-encoding
68    (let ((socket (socket:socket-server port)))                                            :charset 'charset:iso-8859-1
69      (unwind-protect                                            :line-terminator :unix)))
         (progn  
           (funcall announce (socket:socket-server-port socket))  
           (socket:socket-wait socket 0)  
           (socket:socket-accept socket  
                                 :buffered nil  
                                 :element-type 'character  
                                 :external-format (ext:make-encoding  
                                                   :charset 'charset:iso-8859-1  
                                                   :line-terminator :unix)))  
       (socket:socket-server-close socket))))  
   
 (defmethod make-fn-streams (input-fn output-fn)  
   (let* ((output (make-instance 'slime-output-stream  
                                 :output-fn output-fn))  
          (input  (make-instance 'slime-input-stream  
                                 :input-fn input-fn  
                                 :output-stream output)))  
     (values input output)))  
70    
71  ;;; Swank functions  ;;; Swank functions
72    

Legend:
Removed from v.1.7  
changed lines
  Added in v.1.8

  ViewVC Help
Powered by ViewVC 1.1.5