Changeset 12150


Ignore:
Timestamp:
May 28, 2009, 4:15:35 PM (10 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)

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

Legend:

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

    r12117 r12150  
    148148(objc:defmethod (#/startSwankServer: :void) ((self preferences-window-controller)
    149149                                         sender)
     150  (declare (ignore sender))
    150151  (unless (or *ccl-swank-active-p*
    151152              (try-starting-swank :force t))
  • trunk/source/cocoa-ide/start.lisp

    r12141 r12150  
    9191  (values nil nil nil nil))
    9292
    93 #+no
    94 (eval-when (:compile-toplevel :load-toplevel :execute)
    95     (require :swank))
     93;;; preference-start-swank? 
     94;;; returns the current value of the "Start swank server?" user
     95;;; preference
     96(defun preference-start-swank? ()
     97  (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
     98                     (serious-condition (c)
     99                       (progn (log-debug "~%ERROR: Unable to get preferences from the Shared User Defaults Controller")
     100                              nil))))
     101         (start-swank-pref (if (and defaults (not (%null-ptr-p defaults)))
     102                               (#/valueForKey: defaults #@"startSwankServer")         
     103                               nil)))
     104    (cond
     105      ;; the user default is not initialized
     106      ((or (null start-swank-pref)
     107           (%null-ptr-p start-swank-pref)) nil)
     108      ;; examine the user default
     109      ;; intValue works on NSNumber or NSString
     110      ;; BUG? if a string value is not a valid representation of an integer,
     111      ;;      intValue returns 0, which means any non-numeric string will have the
     112      ;;      same effect as "0"
     113      ((or (typep start-swank-pref 'ns:ns-number)
     114           (typep start-swank-pref 'ns:ns-string))
     115       (case (#/intValue start-swank-pref)
     116         ;; don't start swank
     117         (0 nil)
     118         ;; start swank
     119         (1 t)
     120         ;; the user default value is incomprehensible
     121         (otherwise (progn
     122                      (log-debug "~%ERROR: Unrecognized value in user preference 'startSwankServer': ~S"
     123                                 start-swank-pref)
     124                      nil))))
     125      ;; the user default value is incomprehensible
     126      (t (progn
     127           (log-debug "~%ERROR: Unrecognized value type in user preference 'startSwankServer': ~S"
     128                      start-swank-pref)
     129           nil)))))
    96130
    97131(defmethod toplevel-function ((a cocoa-application) init-file)
     
    101135    (#_ _exit -1))
    102136  (setq *standalone-cocoa-ide* t)
     137  (when (preference-start-swank?)
     138        (require :swank)
     139        (try-starting-swank))
    103140  (with-slots  (have-interactive-terminal-io) ccl::*current-process*
    104141    (when (and (eql (nth-value 4 (ccl::%stat "/dev/null"))
     
    107144             )
    108145      (setq have-interactive-terminal-io nil)
     146     
    109147      ;; It's probably reasonable to do this here: it's not really IDE-specific
    110       #+no
    111       (try-starting-swank)
    112148      (when (try-connecting-to-altconsole)
    113149        (setq have-interactive-terminal-io t)))
     
    119155
    120156
    121   (defun build-ide (bundle-path)
     157  (Defun build-ide (bundle-path)
    122158    (setq bundle-path (ensure-directory-pathname bundle-path))
    123159
  • trunk/source/cocoa-ide/swank-ccl-ide.el

    r12136 r12150  
    3333  (message (concat "CCL swank listener: " string)))
    3434
     35(defvar $emacs-ccl-swank-request-marker "[emacs-ccl-swank-request]")
     36
    3537(defun request-ccl-load-swank (&optional
    3638                               (host *ccl-swank-listener-host*)
    37                                (port *ccl-swank-listener-port*))
    38   (let ((ping "[emacs-ccl-swank-request]" (swank-loader-path) "\n")
    39         (ccl-proc (open-network-stream "SLIME CCL Swank" nil host port)))
     39                               (listener-port *ccl-swank-listener-port*)
     40                               (connection-port slime-port))
     41  (let ((ping (concat $emacs-ccl-swank-request-marker (format "%d" connection-port) ":" (swank-loader-path) "\n"))
     42        (ccl-proc (open-network-stream "SLIME CCL Swank" nil host listener-port)))
    4043    (setq *ccl-swank-listener-proc* ccl-proc)
    4144    (set-process-filter ccl-proc 'slime-ccl-swank-filter)
     
    4346    (process-send-string ccl-proc ping)
    4447    ccl-proc))
     48
  • 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.