Ignore:
Timestamp:
May 28, 2009, 4:15:35 PM (11 years ago)
Author:
mikel
Message:

added a bunch of the server-side request-handling code for the swank-listener.

switched the swank loader back on (but made sure swank isn't loaded unless the user default says it should be)

File:
1 edited

Legend:

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

    r12136 r12150  
    4545(swank-loader::load-swank)
    4646
    47 ;;; preference-start-swank? 
    48 ;;; returns the current value of the "Start swank server?" user
    49 ;;; preference
    50 (defun preference-start-swank? ()
    51   (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
    52                      (serious-condition (c)
    53                        (progn (format t "~%ERROR: Unable to get preferences from the Shared User Defaults Controller")
    54                               (force-output)
    55                               nil))))
    56          (start-swank-pref (and defaults (#/valueForKey: defaults #@"startSwankServer"))))
    57     (cond
    58       ;; the user default is not initialized
    59       ((or (null start-swank-pref)
    60            (%null-ptr-p start-swank-pref)) nil)
    61       ;; examine the user default
    62       ((typep start-swank-pref 'ns:ns-number)
    63        (case (#/intValue start-swank-pref)
    64          ;; don't start swank
    65          (0 nil)
    66          ;; start swank
    67          (1 t)
    68          ;; the user default value is incomprehensible
    69          (otherwise (progn
    70                       (format t "~%ERROR: Unrecognized value in user preference 'startSwankServer': ~S"
    71                               start-swank-pref)
    72                       (force-output)
    73                       nil))))
    74       ;; the user default value is incomprehensible
    75       (t (progn
    76            (format t "~%ERROR: Unrecognized value type in user preference 'startSwankServer': ~S"
    77                    start-swank-pref)
    78            (force-output)
    79            nil)))))
    80 
    8147;;; preference-swank-port
    8248;;; returns the current value of the "Swank Port" user preference
     
    8450  (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
    8551                     (serious-condition (c)
    86                        (progn (format t "~%ERROR: Unable to get preferences from the Shared User Defaults Controller")
    87                               (force-output)
     52                       (progn (log-debug "~%ERROR: Unable to get preferences from the Shared User Defaults Controller")
    8853                              nil))))
    8954         (swank-port-pref (and defaults (#/valueForKey: defaults #@"swankPort"))))
     
    10065         (ccl::parse-integer-not-integer-string (c)
    10166           (setf *ccl-swank-active-p* nil)
    102            (format t "~%Error starting swank server; the swank-port user preference is not a valid port number: ~S~%"
    103                    port-str)
    104            (force-output)
     67           (NSLog #@"\nError starting swank server; the swank-port user preference is not a valid port number: %@\n"
     68                  swank-port-pref)
    10569           nil)))
    10670      ;; the user default value is incomprehensible
    10771      (t (progn
    108            (format t "~%ERROR: Unrecognized value type in user preference 'swankPort': ~S"
    109                    swank-port-pref)
    110            (force-output)
     72           (NSLog #@"\nERROR: Unrecognized value type in user preference 'swankPort': %@"
     73                  swank-port-pref)
    11174           nil)))))
    11275
     
    12184    ;; and whether the swank server should be started. If the user says start
    12285    ;; it, and we can determine a valid port for it, start it up
    123     (let* ((start-swank? (or (preference-start-swank?) force))
     86    (let* ((start-swank? (or force (preference-start-swank?)))
    12487           (swank-port (or (preference-swank-port) *default-gui-swank-port*)))
    12588      (if (and start-swank? swank-port)
     
    13497              (setf *ccl-swank-active-p* nil)
    13598              (setf *active-gui-swank-port* nil)
    136               (format t "~%Error starting swank server: ~A~%" c)
    137               (force-output)
     99              (log-debug "~%Error starting swank server: ~A~%" c)
    138100              nil))
    139101          ;; don't try to start the swank server
     
    150112;;; aux utils
    151113
     114(defvar $emacs-ccl-swank-request-marker "[emacs-ccl-swank-request]")
     115
    152116(defun not-ready-yet (nm)
    153117  (error "Not yet implemented: ~A" nm))
    154118
    155119(defun read-swank-ping (tcp-stream)
    156   (not-ready-yet 'read-swank-ping))
    157 
    158 (defun parse-swank-ping (string)
    159   (not-ready-yet 'parse-swank-ping))
     120  (read-line tcp-stream nil nil nil))
     121
     122(defun parse-swank-ping (p)
     123  (let ((sentinel-end (length $emacs-ccl-swank-request-marker)))
     124    (if (typep p 'string)
     125        (if (string= p $emacs-ccl-swank-request-marker :start1 0 :end1 sentinel-end)
     126            (let* ((request (subseq p sentinel-end))
     127                   (split-pos (position #\: request))
     128                   (port-str (if split-pos
     129                                 (subseq request 0 split-pos)
     130                                 nil))
     131                   (port (when port-str (parse-integer port-str :junk-allowed nil)))
     132                   (path-str (if split-pos
     133                                 (subseq request (1+ split-pos))
     134                                 request)))
     135              (values (string-trim '(#\space #\tab #\return #\newline) path-str) port))
     136            nil)
     137        nil)))
    160138
    161139(defun make-swank-loader-pathname (string)
     
    170148(defun send-swank-load-failed (tcp-stream swank-status)
    171149  (not-ready-yet 'send-swank-load-failed))
     150
     151
     152(defun handle-swank-client (c)
     153  (let* ((msg (read-swank-ping c))
     154         (swank-path (parse-swank-ping msg))
     155         (swank-loader (make-swank-loader-pathname swank-path))
     156         (swank-status (load-swank swank-loader)))
     157    (if (swank-ready? swank-status)
     158        (send-swank-ready c swank-status)
     159        (send-swank-load-failed c swank-status))))
    172160
    173161;;; the real deal
     
    175163;;; if it fails, it returns a CONDITION object
    176164(defun start-swank-listener (&optional (port *default-swank-listener-port*))
    177   (flet ((handle-swank-client (c)
    178            (let* ((msg (read-swank-ping c))
    179                   (swank-path (parse-swank-ping msg))
    180                   (swank-loader (make-swank-loader-pathname swank-path))
    181                   (swank-status (load-swank swank-loader)))
    182              (if (swank-ready? swank-status)
    183                  (send-swank-ready c swank-status)
    184                  (send-swank-load-failed c swank-status)))))
    185     (handler-case (with-open-socket (sock :type :stream :connect :passive :local-port port :reuse-address t)
    186                     (loop
    187                        (let ((client-sock (accept-connection sock)))
    188                          (process-run-function "CCL Swank Listener"
    189                                                #'%handle-swank-client client-sock))))
    190       (ccl::socket-creation-error (c) (nslog-condition c "Unable to create a socket for the swank-listener: ") c)
    191       (ccl::socket-error (c) (nslog-condition c "Swank-listener failed trying to accept a client conection: ") c)
    192       (serious-condition (c) (nslog-condition c "Unable to start up the swank listener") c))))
    193 
    194 
     165  (handler-case (with-open-socket (sock :type :stream :connect :passive :local-port port :reuse-address t)
     166                  (loop
     167                     (let ((client-sock (accept-connection sock)))
     168                       (process-run-function "CCL Swank Listener"
     169                                             #'%handle-swank-client client-sock))))
     170    (ccl::socket-creation-error (c) (nslog-condition c "Unable to create a socket for the swank-listener: ") c)
     171    (ccl::socket-error (c) (nslog-condition c "Swank-listener failed trying to accept a client conection: ") c)
     172    (serious-condition (c) (nslog-condition c "Unable to start up the swank listener") c)))
    195173
    196174;;; maybe-start-swank-listener
     
    207185      (if (and start-swank-listener? swank-port)
    208186          ;; try to start the swank listener
    209           (handler-case (progn
    210                           (start-swank-listener swank-listener-port)
    211                           (setf *active-gui-swank-listener-port* swank-listener-port)
    212                           (setf *ccl-swank-listener-active-p* t)
    213                           swank-listener-port)
     187          (handler-case (let ((swank-listener (start-swank-listener swank-listener-port)))
     188                          (if (typep swank-listener 'process)
     189                              (progn
     190                                (setf *active-gui-swank-listener-port* swank-listener-port)
     191                                (setf *ccl-swank-listener-active-p* t)
     192                                swank-listener-port)
     193                              (progn
     194                                (setf *active-gui-swank-listener-port* nil)
     195                                (setf *ccl-swank-listener-active-p* nil)
     196                                nil)))
    214197            ;; swank listener creation failed
    215198            (serious-condition (c)
    216199              (setf *active-gui-swank-listener-port* nil)
    217200              (setf *ccl-swank-listener-active-p* nil)
    218               (format t "~%Error starting swank server: ~A~%" c)
    219               (force-output)
     201              (log-debug "~%Error starting swank server: ~A~%" c)
    220202              nil))
    221203          ;; don't try to start the swank listener
Note: See TracChangeset for help on using the changeset viewer.