Changeset 12214


Ignore:
Timestamp:
Jun 6, 2009, 8:36:40 PM (10 years ago)
Author:
mikel
Message:

lots more errors get caught now. repeatedly using the emacs utility to request a swank load and connection correctly creates multiple swank connections. It's possible to disconnect from and reconnect to a CCl using a swank server loaded by the load request. It's possible to kill CCL and relaunch it, and reconnect to the new CCL using the emacs request.

the handshake is hairy enough that additional uncaught errors probably remain.

Location:
trunk/source/cocoa-ide
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/swank-ccl-ide.el

    r12164 r12214  
    2626
    2727(defvar *ccl-swank-output* nil)
    28 ;;; TODO: make this filter function start up a connection to
    29 ;;;       the CCL swank server if it reads a success message,
    30 ;;;       or display an informative error if it reads a
    31 ;;;       failure message
     28
    3229(defun slime-ccl-swank-filter (process string)
    3330  (let* ((status (read string))
    3431         (active? (plist-get status :active)))
     32    (setq *ccl-swank-output* status)
    3533    (if active?
    3634        (let ((port (plist-get status :port)))
    37           (slime-connect *ccl-swank-listener-host* port)))))
     35          (slime-connect *ccl-swank-listener-host* port))
     36        (error "CCL failed to start the swank server. The reason it gave was: '%s'"
     37               (plist-get status :message)))))
    3838
    3939(defvar $emacs-ccl-swank-request-marker "[emacs-ccl-swank-request]")
  • trunk/source/cocoa-ide/swank-listener.lisp

    r12188 r12214  
    1919(defparameter *active-gui-swank-listener-port* nil)
    2020(defparameter *ccl-swank-listener-active-p* nil)
     21(defvar *swank-listener-process* nil)
     22
     23(defun swank-listener-active? ()
     24  (and *swank-listener-process*
     25       (typep *swank-listener-process* 'process)
     26       (not (member (process-whostate *swank-listener-process*)
     27                    '("Reset" "Exhausted")
     28                    :test 'string-equal))))
    2129
    2230;;; preference-swank-listener-port
     
    99107(defvar $emacs-ccl-swank-request-marker "[emacs-ccl-swank-request]")
    100108
     109(defvar $last-swank-message-sent nil)
     110
     111(defun swank-server-running? ()
     112  (and (find-package :swank)
     113       (let ((active-listeners (symbol-value (intern "*LISTENER-SOCKETS*" :swank))))
     114         (and (not (null active-listeners))
     115              (first active-listeners)))))
     116
    101117(defstruct (swank-status (:conc-name swank-))
    102118  (active? nil :read-only t)
     
    104120  (requested-loader nil :read-only t)
    105121  (requested-port nil :read-only t))
    106 
    107 (defun not-ready-yet (nm)
    108   (error "Not yet implemented: ~A" nm))
    109122
    110123(defun read-swank-ping (tcp-stream)
     
    130143
    131144(defun load-and-start-swank (path requested-port)
    132   (handler-case (progn
    133                   (load path)
    134                   (let ((swank-loader-package (find-package :swank-loader)))
    135                     (if swank-loader-package
    136                         ;; swank loaded. start the server
    137                         (progn
    138                           (funcall (intern "LOAD-SWANK" swank-loader-package))
    139                           (funcall (intern "CREATE-SERVER" (find-package :swank)) :port requested-port :dont-close t)
    140                           (make-swank-status :active? t :requested-loader path :requested-port requested-port))
    141                         ;; swank failed to load. return failure status
    142                         (make-swank-status :active? nil :message "swank load failed" :requested-loader path :requested-port requested-port))))
     145  (handler-case (let* ((active-swank-port (swank-server-running?))
     146                       (msg (format nil "A swank server is already running on port ~A" active-swank-port)))
     147                  (if active-swank-port
     148                      (progn
     149                        (log-debug msg)
     150                        (make-swank-status :active? t :message msg :requested-loader path :requested-port requested-port))
     151                      (progn
     152                        (load path)
     153                        (let ((swank-loader-package (find-package :swank-loader)))
     154                          (if swank-loader-package
     155                              ;; swank loaded. start the server
     156                              (progn
     157                                (funcall (intern "LOAD-SWANK" swank-loader-package))
     158                                (funcall (intern "CREATE-SERVER" (find-package :swank)) :port requested-port :dont-close t)
     159                                (make-swank-status :active? t :requested-loader path :requested-port requested-port))
     160                              ;; swank failed to load. return failure status
     161                              (make-swank-status :active? nil :message "swank load failed" :requested-loader path :requested-port requested-port))))))
    143162    (ccl::socket-creation-error (e) (log-debug "Unable to start a swank server on port: ~A; ~A"
    144163                                               requested-port e)
     
    154173
    155174(defun send-swank-response (tcp-stream status)
    156   (let ((response (format nil "(:active ~S :loader ~S :port ~D)"
    157                           (swank-active? status)
    158                           (swank-requested-loader status)
    159                           (swank-requested-port status))))
     175  (let ((response
     176         (let ((*print-case* :downcase))
     177           (format nil "(:active ~S :loader ~S :message ~S :port ~D)"
     178                   (swank-active? status)
     179                   (swank-requested-loader status)
     180                   (swank-message status)
     181                   (swank-requested-port status)))))
    160182    (format tcp-stream response)
    161183    (finish-output tcp-stream)))
     
    167189      (load-and-start-swank swank-path requested-port))))
    168190
     191(defun stop-swank-listener ()
     192  (process-kill *swank-listener-process*)
     193  (setq *swank-listener-process* nil))
     194
    169195;;; the real deal
    170196;;; if it succeeds, it returns a PROCESS object
     
    172198(defun start-swank-listener (&optional (port *default-swank-listener-port*))
    173199  (handler-case
    174       (process-run-function "Swank Listener"
    175                             #'(lambda ()
    176                                 (with-open-socket (sock :type :stream :connect :passive :local-port port :reuse-address t :auto-close t)
    177                                   (let* ((client-sock (accept-connection sock))
    178                                          (status (handle-swank-client client-sock)))
    179                                     (send-swank-response client-sock status)))))
     200      (if (swank-listener-active?)
     201          (log-debug "in start-swank-listener: the swank listener process is already running")
     202          (setq *swank-listener-process*
     203                (process-run-function "Swank Listener"
     204                                      #'(lambda ()
     205                                          (with-open-socket (sock :type :stream :connect :passive
     206                                                                  :local-port port :reuse-address t :auto-close t)
     207                                            (loop
     208                                               (let* ((client-sock (accept-connection sock))
     209                                                      (status (handle-swank-client client-sock)))
     210                                                 (send-swank-response client-sock status))))))))
    180211    (ccl::socket-creation-error (c) (nslog-condition c "Unable to create a socket for the swank-listener: ") c)
    181212    (ccl::socket-error (c) (nslog-condition c "Swank-listener failed trying to accept a client connection: ") c)
Note: See TracChangeset for help on using the changeset viewer.