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

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

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 size: 9.0 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-swank-port
48;;; returns the current value of the "Swank Port" user preference
49(defun preference-swank-port ()
50  (let* ((defaults (handler-case (#/values (#/sharedUserDefaultsController ns:ns-user-defaults-controller))
51                     (serious-condition (c) 
52                       (progn (log-debug "~%ERROR: Unable to get preferences from the Shared User Defaults Controller")
53                              nil))))
54         (swank-port-pref (and defaults (#/valueForKey: defaults #@"swankPort"))))
55    (cond
56      ;; the user default is not initialized
57      ((or (null swank-port-pref)
58           (%null-ptr-p swank-port-pref)) nil)
59      ;; examine the user default
60      ((typep swank-port-pref 'ns:ns-string) 
61       (handler-case (let* ((port-str (lisp-string-from-nsstring swank-port-pref))
62                            (port (parse-integer port-str :junk-allowed nil)))
63                       (or port *default-gui-swank-port*))
64         ;; parsing the port number failed
65         (ccl::parse-integer-not-integer-string (c)
66           (setf *ccl-swank-active-p* nil)
67           (NSLog #@"\nError starting swank server; the swank-port user preference is not a valid port number: %@\n"
68                  swank-port-pref)
69           nil)))
70      ;; the user default value is incomprehensible
71      (t (progn
72           (NSLog #@"\nERROR: Unrecognized value type in user preference 'swankPort': %@"
73                  swank-port-pref)
74           nil)))))
75
76;;; try-starting-swank (&key (force nil))
77;;; attempts to start the swank server. If :force t is supplied,
78;;; ignores the "Start Swank Server?" user preference and starts the
79;;; server no matter what its value
80
81(defun try-starting-swank (&key (force nil))
82  (unless *ccl-swank-active-p*
83    ;; try to determine the user preferences concerning the swank port number
84    ;; and whether the swank server should be started. If the user says start
85    ;; it, and we can determine a valid port for it, start it up
86    (let* ((start-swank? (or force (preference-start-swank?)))
87           (swank-port (or (preference-swank-port) *default-gui-swank-port*)))
88      (if (and start-swank? swank-port)
89          ;; try to start the swank server
90          (handler-case (progn
91                          (swank:create-server :port swank-port :dont-close t)
92                          (setf *ccl-swank-active-p* t)
93                          (setf *active-gui-swank-port* swank-port)
94                          swank-port)
95            ;; swank server creation failed
96            (serious-condition (c)
97              (setf *ccl-swank-active-p* nil)
98              (setf *active-gui-swank-port* nil)
99              (log-debug "~%Error starting swank server: ~A~%" c)
100              nil))
101          ;; don't try to start the swank server
102          (progn
103            (setf *ccl-swank-active-p* nil)
104            (setf *active-gui-swank-port* nil)
105            nil)))))
106
107
108;;; start-swank-listener
109;;; -----------------------------------------------------------------
110;;; starts up CCL's swank-listener server on the specified port
111
112;;; aux utils
113
114(defvar $emacs-ccl-swank-request-marker "[emacs-ccl-swank-request]")
115
116(defun not-ready-yet (nm)
117  (error "Not yet implemented: ~A" nm))
118
119(defun read-swank-ping (tcp-stream) 
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)))
138
139(defun make-swank-loader-pathname (string) 
140  (not-ready-yet 'make-swank-loader-pathname))
141
142(defun load-swank (pathname) 
143  (not-ready-yet 'load-swank))
144
145(defun send-swank-ready (tcp-stream swank-status)
146  (not-ready-yet 'send-swank-ready))
147
148(defun send-swank-load-failed (tcp-stream swank-status)
149  (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))))
160
161;;; the real deal
162;;; if it succeeds, it returns a PROCESS object
163;;; if it fails, it returns a CONDITION object
164(defun start-swank-listener (&optional (port *default-swank-listener-port*))
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)))
173
174;;; maybe-start-swank-listener
175;;; -----------------------------------------------------------------
176;;; checks whether to start the ccl swank listener, and starts it if
177;;; warranted.
178(defun maybe-start-swank-listener (&optional (force nil))
179  (unless *ccl-swank-active-p*
180    ;; try to determine the user preferences concerning the swank port number
181    ;; and whether the swank listener should be started. If the user says start
182    ;; it, and we can determine a valid port for it, start it up
183    (let* ((start-swank-listener? (or (preference-start-swank?) force))
184           (swank-listener-port (or (preference-swank-port) *default-gui-swank-port*)))
185      (if (and start-swank-listener? swank-port)
186          ;; try to start the swank listener
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)))
197            ;; swank listener creation failed
198            (serious-condition (c)
199              (setf *active-gui-swank-listener-port* nil)
200              (setf *ccl-swank-listener-active-p* nil)
201              (log-debug "~%Error starting swank server: ~A~%" c)
202              nil))
203          ;; don't try to start the swank listener
204          (progn
205            (setf *active-gui-swank-listener-port* nil)
206            (setf *ccl-swank-listener-active-p* nil)
207            nil)))))
208
209(provide :swank)
Note: See TracBrowser for help on using the repository browser.