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

Diff of /slime/swank.lisp

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

revision 1.112 by heller, Sat Jan 31 11:50:25 2004 UTC revision 1.113 by heller, Sat Jan 31 20:17:19 2004 UTC
# Line 47  Line 47 
47        (error "Backend function ~A not implemented." ',fun))        (error "Backend function ~A not implemented." ',fun))
48      (export ',fun :swank)))      (export ',fun :swank)))
49    
50    (declaim (ftype (function () nil) missing-arg))
51    (defun missing-arg ()
52      (error "A required &KEY or &OPTIONAL argument was not supplied."))
53    
54    
55  ;;;; Connections  ;;;; Connections
56  ;;;  ;;;
# Line 91  Line 95 
95               ;; (:print-function %print-connection)               ;; (:print-function %print-connection)
96               )               )
97    ;; Raw I/O stream of socket connection.    ;; Raw I/O stream of socket connection.
98    (socket-io        nil :type stream :read-only t)    (socket-io        (missing-arg) :type stream :read-only t)
99    ;; Optional dedicated output socket (backending `user-output' slot).    ;; Optional dedicated output socket (backending `user-output' slot).
100    ;; Has a slot so that it can be closed with the connection.    ;; Has a slot so that it can be closed with the connection.
101    (dedicated-output nil :type (or stream null))    (dedicated-output nil :type (or stream null))
# Line 103  Line 107 
107    ;;    ;;
108    (control-thread   nil :read-only t)    (control-thread   nil :read-only t)
109    (reader-thread    nil :read-only t)    (reader-thread    nil :read-only t)
110    read    (read             (missing-arg) :type function)
111    send    (send             (missing-arg) :type function)
112    serve-requests    (serve-requests   (missing-arg) :type function)
113    cleanup    (cleanup          nil :type (or null function))
114    )    )
115    
116  (defvar *emacs-connection* nil  (defvar *emacs-connection* nil
# Line 178  Redirection is done while Lisp is proces Line 182  Redirection is done while Lisp is proces
182    
183  (defvar *use-dedicated-output-stream* t)  (defvar *use-dedicated-output-stream* t)
184  (defvar *swank-in-background* nil)  (defvar *swank-in-background* nil)
185  (defvar *log-events* t)  (defvar *log-events* nil)
186    
187  (defun start-server (port-file)  (defun start-server (port-file)
188    (setup-server 0 (lambda (port) (announce-server-port port-file port))    (setup-server 0 (lambda (port) (announce-server-port port-file port))
# Line 287  determined at compile time." Line 291  determined at compile time."
291  (defun close-connection (c &optional condition)  (defun close-connection (c &optional condition)
292    (when condition    (when condition
293      (format *debug-io* "~&;; Connection to Emacs lost.~%;; [~A]~%" condition))      (format *debug-io* "~&;; Connection to Emacs lost.~%;; [~A]~%" condition))
294    (when (connection.cleanup c)    (let ((cleanup (connection.cleanup c)))
295      (funcall (connection.cleanup c) c))      (when cleanup
296          (funcall cleanup c)))
297    (close (connection.socket-io c))    (close (connection.socket-io c))
298    (when (connection.dedicated-output c)    (when (connection.dedicated-output c)
299      (close (connection.dedicated-output c))))      (close (connection.dedicated-output c))))
# Line 313  determined at compile time." Line 318  determined at compile time."
318  (defun drop&find (item list key test)  (defun drop&find (item list key test)
319    "Return LIST where item is removed together with the removed    "Return LIST where item is removed together with the removed
320  element."  element."
321      (declare (type function key test))
322    (do ((stack '() (cons (car l) stack))    (do ((stack '() (cons (car l) stack))
323         (l list (cdr l)))         (l list (cdr l)))
324        ((null l) (values (nreverse stack) nil))        ((null l) (values (nreverse stack) nil))
# Line 402  element." Line 408  element."
408                            :user-input in :user-output out :user-io io                            :user-input in :user-output out :user-io io
409                            :control-thread control-thread                            :control-thread control-thread
410                            :reader-thread reader-thread                            :reader-thread reader-thread
411                            :read 'read-from-control-thread                            :read #'read-from-control-thread
412                            :send 'send-to-control-thread                            :send #'send-to-control-thread
413                            :serve-requests (lambda (c) c))))                            :serve-requests (lambda (c) c))))
414        (:sigio        (:sigio
415         (make-connection :socket-io socket-io :dedicated-output dedicated         (make-connection :socket-io socket-io :dedicated-output dedicated
416                          :user-input in :user-output out :user-io io                          :user-input in :user-output out :user-io io
417                          :read 'read-from-socket-io                          :read #'read-from-socket-io
418                          :send 'send-to-socket-io                          :send #'send-to-socket-io
419                          :serve-requests 'install-sigio-handler                          :serve-requests #'install-sigio-handler
420                          :cleanup 'remove-sigio-handler))                          :cleanup #'remove-sigio-handler))
421        ((nil)        ((nil)
422         (make-connection :socket-io socket-io :dedicated-output dedicated         (make-connection :socket-io socket-io :dedicated-output dedicated
423                          :user-input in :user-output out :user-io io                          :user-input in :user-output out :user-io io
424                          :read 'read-from-socket-io                          :read #'read-from-socket-io
425                          :send 'send-to-socket-io                          :send #'send-to-socket-io
426                          :serve-requests 'simple-serve-requests)))))                          :serve-requests #'simple-serve-requests)))))
427    
428  (defun install-sigio-handler (connection)  (defun install-sigio-handler (connection)
429    (let ((client (connection.socket-io connection)))    (let ((client (connection.socket-io connection)))
# Line 447  element." Line 453  element."
453      (log-event "DISPATCHING: ~S~%" event)      (log-event "DISPATCHING: ~S~%" event)
454      (destructure-case event      (destructure-case event
455        ((:emacs-rex string package thread id)        ((:emacs-rex string package thread id)
456           (declare (ignore thread))
457         `(eval-string ,string ,package ,id))         `(eval-string ,string ,package ,id))
458        ((:emacs-interrupt thread)        ((:emacs-interrupt thread)
459           (declare (ignore thread))
460         '(simple-break))         '(simple-break))
461        ((:emacs-return-string thread tag string)        ((:emacs-return-string thread tag string)
462           (declare (ignore thread))
463         `(take-input ,tag ,string)))))         `(take-input ,tag ,string)))))
464    
465  (defun send-to-socket-io (event)  (defun send-to-socket-io (event)

Legend:
Removed from v.1.112  
changed lines
  Added in v.1.113

  ViewVC Help
Powered by ViewVC 1.1.5