source: trunk/source/cocoa-ide/swank.lisp @ 12136

Last change on this file since 12136 was 12136, checked in by mikel, 11 years ago

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.

File size: 9.6 KB
Line 
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
34(in-package :GUI)
35
36(defparameter *default-gui-swank-port* 4564)
37(defparameter *active-gui-swank-port* nil)
38(defparameter *ccl-swank-active-p* nil)
39
40(defparameter *default-swank-listener-port* 4884)
41(defparameter *active-gui-swank-listener-port* nil)
42(defparameter *ccl-swank-listener-active-p* nil)
43
44(load #P"ccl:cocoa-ide;slime;swank-loader.lisp")
45(swank-loader::load-swank)
46
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
81;;; preference-swank-port
82;;; returns the current value of the "Swank Port" user preference
83(defun preference-swank-port ()
84  (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
85                     (serious-condition (c) 
86                       (progn (format t "~%ERROR: Unable to get preferences from the Shared User Defaults Controller")
87                              (force-output)
88                              nil))))
89         (swank-port-pref (and defaults (#/valueForKey: defaults #@"swankPort"))))
90    (cond
91      ;; the user default is not initialized
92      ((or (null swank-port-pref)
93           (%null-ptr-p swank-port-pref)) nil)
94      ;; examine the user default
95      ((typep swank-port-pref 'ns:ns-string) 
96       (handler-case (let* ((port-str (lisp-string-from-nsstring swank-port-pref))
97                            (port (parse-integer port-str :junk-allowed nil)))
98                       (or port *default-gui-swank-port*))
99         ;; parsing the port number failed
100         (ccl::parse-integer-not-integer-string (c)
101           (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)
105           nil)))
106      ;; the user default value is incomprehensible
107      (t (progn
108           (format t "~%ERROR: Unrecognized value type in user preference 'swankPort': ~S"
109                   swank-port-pref)
110           (force-output)
111           nil)))))
112
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
118(defun try-starting-swank (&key (force nil))
119  (unless *ccl-swank-active-p*
120    ;; try to determine the user preferences concerning the swank port number
121    ;; and whether the swank server should be started. If the user says start
122    ;; it, and we can determine a valid port for it, start it up
123    (let* ((start-swank? (or (preference-start-swank?) force))
124           (swank-port (or (preference-swank-port) *default-gui-swank-port*)))
125      (if (and start-swank? swank-port)
126          ;; try to start the swank server
127          (handler-case (progn
128                          (swank:create-server :port swank-port :dont-close t)
129                          (setf *ccl-swank-active-p* t)
130                          (setf *active-gui-swank-port* swank-port)
131                          swank-port)
132            ;; swank server creation failed
133            (serious-condition (c)
134              (setf *ccl-swank-active-p* nil)
135              (setf *active-gui-swank-port* nil)
136              (format t "~%Error starting swank server: ~A~%" c)
137              (force-output)
138              nil))
139          ;; don't try to start the swank server
140          (progn
141            (setf *ccl-swank-active-p* nil)
142            (setf *active-gui-swank-port* nil)
143            nil)))))
144
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
227(provide :swank)
Note: See TracBrowser for help on using the repository browser.