Changeset 12136


Ignore:
Timestamp:
May 27, 2009, 12:07:21 PM (10 years ago)
Author:
mikel
Message:

added elisp and ccl sides of a simple protocol with which SLIME can request CCL to load and start swank. Not quite working yet; still need to add response-handling in the elisp side, and the code that checks for swank and reports the results n the CCL side. The IDE build loads the code but does not yet turn on the swank listener.

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

Legend:

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

    r12022 r12136  
    283283(pushnew '(log-debug . 0) ccl::*format-arg-functions* :test #'equal)
    284284
    285 (defun nslog-condition (c)
     285(defun nslog-condition (c &optional (msg "Error in event loop: "))
    286286  (let* ((rep (format nil "~a" c)))
    287     (with-cstrs ((str rep))
     287    (with-cstrs ((str rep)
     288                 (msg-str msg))
    288289      (with-nsstr (nsstr str (length rep))
    289         (#_NSLog #@"Error in event loop: %@" :address nsstr)))))
     290        (with-nsstr (nsmsg msg-str (length msg))
     291         (#_NSLog #@"%@: %@" :address nsmsg :address nsstr))))))
    290292
    291293(defun nsstring-for-lisp-condition (cond)
  • trunk/source/cocoa-ide/swank.lisp

    r12116 r12136  
     1;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: cl-user -*-
     2;;;; ***********************************************************************
     3;;;; FILE IDENTIFICATION
     4;;;;
     5;;;; Name:          swank.lisp
     6;;;; Project:       CCL IDE
     7;;;; Purpose:       CCL's swank loader
     8;;;;
     9;;;; ***********************************************************************
     10
     11;;; ABOUT
     12;;; ------------------------------------------------------------------------
     13;;; implements tools used to loacte and load a swank server at app startup.
     14;;; provides an interface through which a client program can request
     15;;; loading of a specific copy of swank for use with SLIME
     16;;;
     17;;; ccl == the command-line lisp executable
     18;;; CCL == the Cocoa lisp application
     19;;;
     20;;; CCL/ccl starts a swank server in one of the following ways:
     21;;;
     22;;; 1. Emacs starts ccl as an inferior SLIME process
     23;;;    In this case, emacs tells ccl at startup where to get the swank
     24;;;    loader. ccl loads the swank indicated by the input from emacs
     25;;;    and starts it up
     26;;;
     27;;; 2. Emacs connects to an already-running CCL
     28
     29;;;    If CCL starts up from the Finder, not under the control of an
     30;;;    emacs process, it starts a swank listener. The swank listener
     31;;;    listens on a port for connections using the swank protocol.
     32
     33
    134(in-package :GUI)
    235
     
    538(defparameter *ccl-swank-active-p* nil)
    639
     40(defparameter *default-swank-listener-port* 4884)
     41(defparameter *active-gui-swank-listener-port* nil)
     42(defparameter *ccl-swank-listener-active-p* nil)
     43
    744(load #P"ccl:cocoa-ide;slime;swank-loader.lisp")
    845(swank-loader::load-swank)
    946
     47;;; preference-start-swank? 
     48;;; returns the current value of the "Start swank server?" user
     49;;; preference
    1050(defun preference-start-swank? ()
    1151  (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
     
    3979           nil)))))
    4080
     81;;; preference-swank-port
     82;;; returns the current value of the "Swank Port" user preference
    4183(defun preference-swank-port ()
    4284  (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
     
    69111           nil)))))
    70112
     113;;; try-starting-swank (&key (force nil))
     114;;; attempts to start the swank server. If :force t is supplied,
     115;;; ignores the "Start Swank Server?" user preference and starts the
     116;;; server no matter what its value
     117
    71118(defun try-starting-swank (&key (force nil))
    72119  (unless *ccl-swank-active-p*
     
    96143            nil)))))
    97144
     145
     146;;; start-swank-listener
     147;;; -----------------------------------------------------------------
     148;;; starts up CCL's swank-listener server on the specified port
     149
     150;;; aux utils
     151
     152(defun not-ready-yet (nm)
     153  (error "Not yet implemented: ~A" nm))
     154
     155(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))
     160
     161(defun make-swank-loader-pathname (string)
     162  (not-ready-yet 'make-swank-loader-pathname))
     163
     164(defun load-swank (pathname)
     165  (not-ready-yet 'load-swank))
     166
     167(defun send-swank-ready (tcp-stream swank-status)
     168  (not-ready-yet 'send-swank-ready))
     169
     170(defun send-swank-load-failed (tcp-stream swank-status)
     171  (not-ready-yet 'send-swank-load-failed))
     172
     173;;; the real deal
     174;;; if it succeeds, it returns a PROCESS object
     175;;; if it fails, it returns a CONDITION object
     176(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
     195
     196;;; maybe-start-swank-listener
     197;;; -----------------------------------------------------------------
     198;;; checks whether to start the ccl swank listener, and starts it if
     199;;; warranted.
     200(defun maybe-start-swank-listener (&optional (force nil))
     201  (unless *ccl-swank-active-p*
     202    ;; try to determine the user preferences concerning the swank port number
     203    ;; and whether the swank listener should be started. If the user says start
     204    ;; it, and we can determine a valid port for it, start it up
     205    (let* ((start-swank-listener? (or (preference-start-swank?) force))
     206           (swank-listener-port (or (preference-swank-port) *default-gui-swank-port*)))
     207      (if (and start-swank-listener? swank-port)
     208          ;; 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)
     214            ;; swank listener creation failed
     215            (serious-condition (c)
     216              (setf *active-gui-swank-listener-port* nil)
     217              (setf *ccl-swank-listener-active-p* nil)
     218              (format t "~%Error starting swank server: ~A~%" c)
     219              (force-output)
     220              nil))
     221          ;; don't try to start the swank listener
     222          (progn
     223            (setf *active-gui-swank-listener-port* nil)
     224            (setf *ccl-swank-listener-active-p* nil)
     225            nil)))))
     226
    98227(provide :swank)
Note: See TracChangeset for help on using the changeset viewer.