/[slime]/slime/swank-backend.lisp
ViewVC logotype

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.16 - (show annotations)
Tue Jan 13 18:16:37 2004 UTC (10 years, 3 months ago) by heller
Branch: MAIN
Changes since 1.15: +16 -17 lines
(create-socket, local-port, close-socket, accept-connection,
add-input-handler, spawn): New functions.
(accept-socket/stream, accept-socket/run): Deleted.
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
2 ;;;
3 ;;; slime-backend.lisp --- SLIME backend interface.
4 ;;;
5 ;;; Created by James Bielman in 2003. Released into the public domain.
6 ;;;
7 ;;; This file defines the functions that must be implemented
8 ;;; separately for each Lisp. Each is declared as a generic function
9 ;;; for which swank-<implementation>.lisp provides methods.
10
11 (defpackage :swank
12 (:use :common-lisp)
13 (:nicknames #:swank-backend)
14 (:export #:*sldb-pprint-frames*
15 #:apropos-list-for-emacs
16 #:arglist-string
17 #:backtrace
18 #:call-with-I/O-lock
19 #:call-with-conversation-lock
20 #:compiler-notes-for-emacs
21 #:completions
22 #:create-server
23 #:create-swank-server
24 #:describe-alien-enum
25 #:describe-alien-struct
26 #:describe-alien-type
27 #:describe-alien-union
28 #:describe-class
29 #:describe-function
30 #:describe-inspectee
31 #:describe-setf-function
32 #:describe-symbol
33 #:describe-type
34 #:disassemble-symbol
35 #:documentation-symbol
36 #:eval-in-frame
37 #:eval-string
38 #:eval-string-in-frame
39 #:find-function-locations
40 #:frame-catch-tags
41 #:frame-locals
42 #:frame-source-location-for-emacs
43 #:frame-source-position
44 #:getpid
45 #:give-goahead
46 #:give-gohead
47 #:init-inspector
48 #:inspect-in-frame
49 #:inspect-nth-part
50 #:inspector-next
51 #:inspector-pop
52 #:interactive-eval
53 #:interactive-eval-region
54 #:invoke-nth-restart
55 #:invoke-nth-restart-for-emacs
56 #:list-all-package-names
57 #:list-callees
58 #:list-callers
59 #:listener-eval
60 #:load-file
61 #:pprint-eval
62 #:pprint-eval-string-in-frame
63 #:quit-inspector
64 #:re-evaluate-defvar
65 #:set-default-directory
66 #:set-package
67 #:sldb-abort
68 #:sldb-break-with-default-debugger
69 #:sldb-continue
70 #:slime-debugger-function
71 #:start-server
72 #:startup-multiprocessing
73 #:startup-multiprocessing-for-emacs
74 #:swank-compile-file
75 #:swank-compile-string
76 #:swank-macroexpand
77 #:swank-macroexpand-1
78 #:swank-macroexpand-all
79 #:take-input
80 #:thread-id
81 #:thread-name
82 #:throw-to-toplevel
83 #:toggle-trace-fdefinition
84 #:untrace-all
85 #:wait-goahead
86 #:who-binds
87 #:who-calls
88 #:who-macroexpands
89 #:who-references
90 #:who-sets
91 ))
92
93 (in-package :swank)
94
95
96 ;;;; TCP server
97
98 (defgeneric create-socket (port)
99 (:documentation "Create a listening TCP socket on port PORT."))
100
101 (defgeneric local-port (socket)
102 (:documentation "Return the local port number of SOCKET."))
103
104 (defgeneric close-socket (socket)
105 (:documentation "Close the socket SOCKET."))
106
107 (defgeneric accept-connection (socket)
108 (:documentation
109 "Accept a client connection on the listening socket SOCKET. Return
110 a stream for the new connection."))
111
112 (defgeneric add-input-handler (socket fn)
113 (:documentation "Call FN whenever SOCKET is readable."))
114
115 (defgeneric spawn (fn &key name)
116 (:documentation "Create a new process and call FN in the new process."))
117
118 ;;; Base condition for networking errors.
119 (define-condition network-error (error) ())
120
121 (defgeneric emacs-connected ()
122 (:documentation
123 "Hook called when the first connection from Emacs is established.
124 Called from the INIT-FN of the socket server that accepts the
125 connection.
126
127 This is intended for setting up extra context, e.g. to discover
128 that the calling thread is the one that interacts with Emacs."))
129
130 (defmethod no-applicable-method ((m (eql #'emacs-connected)) &rest _)
131 (declare (ignore _))
132 nil)
133
134
135 ;;;; Compilation
136
137 (defgeneric call-with-compilation-hooks (func)
138 (:documentation
139 "Call FUNC with hooks to trigger SLDB on compiler errors."))
140
141 (defmacro with-compilation-hooks ((&rest ignore) &body body)
142 (declare (ignore ignore))
143 `(call-with-compilation-hooks (lambda () (progn ,@body))))
144
145 (defgeneric compile-string-for-emacs (string &key buffer position)
146 (:documentation
147 "Compile source from STRING. During compilation, compiler
148 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
149
150 If supplied, BUFFER and POSITION specify the source location in Emacs.
151
152 Additionally, if POSITION is supplied, it must be added to source
153 positions reported in compiler conditions."))
154
155 (defgeneric compile-file-for-emacs (filename load-p)
156 (:documentation
157 "Compile FILENAME signalling COMPILE-CONDITIONs.
158 If LOAD-P is true, load the file after compilation."))
159
160 ;;;;; Compiler conditions
161
162 (deftype severity () '(member :error :warning :style-warning :note))
163
164 ;; Base condition type for compiler errors, warnings and notes.
165 (define-condition compiler-condition (condition)
166 ((original-condition
167 ;; The original condition thrown by the compiler if appropriate.
168 ;; May be NIL if a compiler does not report using conditions.
169 :type (or null condition)
170 :initarg :original-condition
171 :accessor original-condition)
172
173 (severity :type severity
174 :initarg :severity
175 :accessor severity)
176
177 (message :initarg :message
178 :accessor message)
179
180 (location :initarg :location
181 :accessor location)))
182
183 ;;;
184 ;;;; Streams
185
186 (defgeneric make-fn-streams (input-fn output-fn)
187 (:documentation
188 "Return character input and output streams backended by functions.
189 When input is needed, INPUT-FN is called with no arguments to
190 return a string.
191 When output is ready, OUTPUT-FN is called with the output as its
192 argument.
193
194 Output should be forced to OUTPUT-FN before calling INPUT-FN.
195
196 The streams are returned as two values."))
197
198
199 ;;;; Documentation
200
201 (defgeneric arglist-string (function-name)
202 (:documentation
203 "Return the argument for FUNCTION-NAME as a string.
204 The result should begin and end with parenthesis."))
205
206 (defgeneric macroexpand-all (form)
207 (:documentation
208 "Recursively expand all macros in FORM.
209 Return the resulting form."))
210
211 (defgeneric describe-symbol-for-emacs (symbol)
212 (:documentation
213 "Return a property list describing SYMBOL.
214
215 The property list has an entry for each interesting aspect of the
216 symbol. The recognised keys are:
217
218 :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO
219 :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
220
221 The value of each property is the corresponding documentation string,
222 or :NOT-DOCUMENTED. It is legal to include keys not listed here.
223
224 Properties should be included if and only if they are applicable to
225 the symbol. For example, only (and all) fbound symbols should include
226 the :FUNCTION property.
227
228 Example:
229 \(describe-symbol-for-emacs 'vector)
230 => (:CLASS :NOT-DOCUMENTED
231 :TYPE :NOT-DOCUMENTED
232 :FUNCTION \"Constructs a simple-vector from the given objects.\")"))
233
234
235 ;;;; Debugging
236
237 (defgeneric call-with-debugging-environment (debugger-loop-fn)
238 (:documentation
239 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
240
241 This function is called recursively at each debug level to invoke the
242 debugger loop. The purpose is to setup any necessary environment for
243 other debugger callbacks that will be called within the debugger loop.
244
245 For example, this is a reasonable place to compute a backtrace, switch
246 to safe reader/printer settings, and so on."))
247
248 (define-condition sldb-condition (condition)
249 ((original-condition
250 :initarg :original-condition
251 :accessor original-condition))
252 (:documentation
253 "Wrapper for conditions that should not be debugged.
254
255 When a condition arises from the internals of the debugger, it is not
256 desirable to debug it -- we'd risk entering an endless loop trying to
257 debug the debugger! Instead, such conditions can be reported to the
258 user without (re)entering the debugger by wrapping them as
259 `sldb-condition's."))
260
261 (defgeneric debugger-info-for-emacs (start end)
262 (:documentation
263 "Return debugger state, with stack frames from START to END.
264 The result is a list:
265 (condition ({restart}*) ({stack-frame}*)
266 where
267 condition ::= (description type)
268 restart ::= (name description)
269 stack-frame ::= (number description)
270
271 condition---a pair of strings: message, and type.
272
273 restart---a pair of strings: restart name, and description.
274
275 stack-frame---a number from zero (the top), and a printed
276 representation of the frame's call.
277
278 Below is an example return value. In this case the condition was a
279 division by zero (multi-line description), and only one frame is being
280 fetched (start=0, end=1).
281
282 ((\"Arithmetic error DIVISION-BY-ZERO signalled.
283 Operation was KERNEL::DIVISION, operands (1 0).\"
284 \"[Condition of type DIVISION-BY-ZERO]\")
285 ((\"ABORT\" \"Return to Slime toplevel.\")
286 (\"ABORT\" \"Return to Top-Level.\"))
287 ((0 \"(KERNEL::INTEGER-/-INTEGER 1 0)\")))"))
288
289 (defgeneric backtrace (start end)
290 (:documentation
291 "Return a list containing a backtrace of the condition current
292 being debugged. The results are unspecified if this function is
293 called outside the dynamic contour of a debugger hook defined by
294 DEFINE-DEBUGGER-HOOK.
295
296 START and END are zero-based indices constraining the number of
297 frames returned. Frame zero is defined as the frame which invoked
298 the debugger.
299
300 The backtrace is returned as a list of tuples of the form
301 \(FRAME-NUMBER FRAME-DESCRIPTION), where FRAME-NUMBER is the
302 index of the frame, defined like START/END, and FRAME-DESCRIPTION
303 is a string containing text to display in the debugger for this
304 frame.
305
306 An example return value:
307
308 ((0 \"(HELLO \"world\")\")
309 (1 \"(RUN-EXCITING-LISP-DEMO)\")
310 (2 \"(SYS::%TOPLEVEL #<SYS::ENVIRONMENT #x394834>)\"))"))
311
312 (defgeneric frame-source-location-for-emacs (frame-number)
313 (:documentation
314 "Return the source location for FRAME-NUMBER."))
315
316 (defgeneric frame-catch-tags (frame-number)
317 (:documentation
318 "Return a list of XXX list of what? catch tags for a debugger
319 stack frame. The results are undefined unless this is called
320 within the dynamic contour of a function defined by
321 DEFINE-DEBUGGER-HOOK."))
322
323 (defgeneric frame-locals (frame-number)
324 (:documentation
325 "Return a list of XXX local variable designators define me
326 for a debugger stack frame. The results are undefined unless
327 this is called within the dynamic contour of a function defined
328 by DEFINE-DEBUGGER-HOOK."))
329
330 (defgeneric eval-in-frame (form frame-number)
331 (:documentation
332 "Evaluate a Lisp form in the lexical context of a stack frame
333 in the debugger. The results are undefined unless called in the
334 dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
335
336 FRAME-NUMBER must be a positive integer with 0 indicating the
337 frame which invoked the debugger.
338
339 The return value is the result of evaulating FORM in the
340 appropriate context."))
341
342
343 ;;;; Queries
344
345 #+(or)
346 ;;; This is probably a better interface than find-function-locations.
347 (defgeneric find-definitions (name)
348 (:documentation
349 "Return a list of (LABEL . LOCATION) pairs for NAME's definitions.
350
351 NAME is string denoting a symbol or \"definition specifier\".
352
353 LABEL is a string describing the definition, e.g., \"foo\" or
354 \"(method foo (string number))\" or \"(variable bar)\".
355
356 LOCATION is a source location of the form:
357
358 <location> ::= (:location <buffer> <position>)
359 | (:error <message>)
360
361 <buffer> ::= (:file <filename>)
362 | (:buffer <buffername>)
363 | (:source-form <string>)
364
365 <position> ::= (:position <fixnum> [<align>]) ; 1 based
366 | (:function-name <string>)
367 "))
368
369 (defgeneric find-function-locations (name)
370 (:documentation
371 "Return a list (LOCATION LOCATION ...) for NAME's definitions.
372
373 LOCATION is a source location of the form:
374
375 <location> ::= (:location <buffer> <position>)
376 | (:error <message>)
377
378 <buffer> ::= (:file <filename>)
379 | (:buffer <buffername>)
380 | (:source-form <string>)
381
382 <position> ::= (:position <fixnum> [<align>]) ; 1 based
383 | (:line <fixnum> [<fixnum>])
384 | (:function-name <string>)
385 | (:source-path <list> <start-position>)
386 "))
387
388
389 ;;;; Multiprocessing
390
391 (defgeneric startup-multiprocessing ()
392 (:documentation
393 "Initialize multiprocessing, if necessary.
394
395 This function is called directly through the listener, not in an RPC
396 from Emacs. This is to support interfaces such as CMUCL's
397 MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
398 normal function."))
399
400 (defgeneric thread-id ()
401 (:documentation
402 "Return a value that uniquely identifies the current thread.
403 Thread-IDs allow Emacs to refer to individual threads.
404
405 When called several times by the same thread, all return values are
406 EQUAL. The value has a READable printed representation that preserves
407 equality. The printed representation must be identical in Emacs Lisp
408 and Common Lisp, and short enough to include in the REPL prompt.
409
410 For example, a THREAD-ID could be an integer or a short ASCII string.
411
412 Systems that do not support multiprocessing return NIL."))
413
414 (defgeneric thread-name (thread-id)
415 (:documentation
416 "Return the name of the thread identified by THREAD-ID.
417
418 Thread names are be single-line strings and are meaningful to the
419 user. They do not have to be unique."))
420
421 (defgeneric call-with-I/O-lock (function)
422 (:documentation
423 "Call FUNCTION with the \"I/O\" lock held.
424 Only one thread can hold the I/O lock at a time -- others are blocked
425 until they acquire it. When called recursively (i.e. lock already
426 held), simply calls FUNCTION.
427
428 This is a low-level lock used for mutual exclusion on individual
429 messages read and written to the socket connecting Emacs.
430
431 Systems that do not support multiprocessing simply call FUNCTION."))
432
433 (defgeneric call-with-conversation-lock (function)
434 (:documentation
435 "Call FUNCTION with the \"conversation\" lock held.
436 The semantics are analogous to CALL-WITH-I/O-HOOK.
437
438 This is a high-level lock used for mutual exclusion in conversations
439 with Emacs that can span multiple messages. The I/O lock must
440 separately be held when reading and writing individual messages."))
441
442 ;;; Functions for attracting the Emacs user's attention.
443
444 (defgeneric wait-goahead ()
445 (:documentation
446 "Block until told to continue by `give-gohead'.
447
448 Systems that do not support multiprocessing return immediately."))
449
450 (defgeneric give-goahead (thread-id)
451 (:documentation
452 "Permit THREAD-ID to continue from WAIT-GOAHEAD.
453 It is an error to call (GIVE-GOAHEAD ID) unless ID is blocking in
454 WAIT-GOAHEAD.
455
456 Systems that do not support multiprocessing always signal an error."))
457
458
459 ;;;;; Default implementation for non-MP systems
460
461 ;;; Using NO-APPLICABLE-METHOD to supply a default implementation that
462 ;;; works in systems that don't have multiprocessing.
463 ;;; (Good or bad idea? -luke)
464
465 (defmethod no-applicable-method ((m (eql #'startup-multiprocessing)) &rest _)
466 (declare (ignore _))
467 nil)
468 (defmethod no-applicable-method ((m (eql #'thread-id)) &rest _)
469 (declare (ignore _))
470 nil)
471 (defmethod no-applicable-method ((m (eql #'thread-name)) &rest _)
472 (declare (ignore _))
473 "The One True Thread")
474 (defmethod no-applicable-method ((m (eql #'call-with-I/O-lock))
475 &rest args)
476 (funcall (first args)))
477 (defmethod no-applicable-method ((m (eql #'call-with-conversation-lock))
478 &rest args)
479 (funcall (first args)))
480 (defmethod no-applicable-method ((m (eql #'wait-goahead)) &rest _)
481 (declare (ignore _))
482 t)
483 (defmethod no-applicable-method ((m (eql #'give-goahead)) &rest _)
484 (declare (ignore _))
485 (error "SLIME multiprocessing not available"))
486

  ViewVC Help
Powered by ViewVC 1.1.5