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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.75 - (hide annotations)
Fri Nov 19 19:05:25 2004 UTC (9 years, 4 months ago) by heller
Branch: MAIN
Changes since 1.74: +1 -1 lines
(accept-connection): Accept :external-format as argument.
1 lgorrie 1.1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
2     ;;;
3 lgorrie 1.13 ;;; slime-backend.lisp --- SLIME backend interface.
4 lgorrie 1.1 ;;;
5 lgorrie 1.13 ;;; Created by James Bielman in 2003. Released into the public domain.
6 lgorrie 1.1 ;;;
7 lgorrie 1.13 ;;; 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 lgorrie 1.1
11 heller 1.36 (defpackage :swank-backend
12 lgorrie 1.1 (:use :common-lisp)
13 heller 1.36 (:export #:sldb-condition
14     #:original-condition
15     #:compiler-condition
16     #:message
17     #:short-message
18     #:condition
19     #:severity
20     #:location
21     #:location-p
22     #:location-buffer
23     #:location-position
24     #:position-p
25     #:position-pos
26     #:print-output-to-string
27 mbaringer 1.42 #:quit-lisp
28 crhodes 1.62 #:references
29 mbaringer 1.67 #:unbound-slot-filler
30     ;; inspector related symbols
31     #:inspector
32     #:inspect-for-emacs
33     #:raw-inspection
34     #:fancy-inspection
35 heller 1.70 #:label-value-line
36     #:label-value-line*
37 mbaringer 1.67 ))
38 lgorrie 1.1
39 mbaringer 1.65 (defpackage :swank-mop
40     (:use)
41     (:export
42     ;; classes
43     #:standard-generic-function
44     #:standard-slot-definition
45     #:standard-method
46     #:standard-class
47 mbaringer 1.68 #:eql-specializer
48     #:eql-specializer-object
49 mbaringer 1.65 ;; standard-class readers
50     #:class-default-initargs
51     #:class-direct-default-initargs
52     #:class-direct-slots
53     #:class-direct-subclasses
54     #:class-direct-superclasses
55     #:class-finalized-p
56     #:class-name
57     #:class-precedence-list
58     #:class-prototype
59     #:class-slots
60 mbaringer 1.68 #:specializer-direct-methods
61 mbaringer 1.65 ;; generic function readers
62     #:generic-function-argument-precedence-order
63     #:generic-function-declarations
64     #:generic-function-lambda-list
65     #:generic-function-methods
66     #:generic-function-method-class
67     #:generic-function-method-combination
68     #:generic-function-name
69     ;; method readers
70     #:method-generic-function
71     #:method-function
72     #:method-lambda-list
73     #:method-specializers
74     #:method-qualifiers
75     ;; slot readers
76     #:slot-definition-allocation
77     #:slot-definition-documentation
78     #:slot-definition-initargs
79     #:slot-definition-initform
80     #:slot-definition-initfunction
81     #:slot-definition-name
82     #:slot-definition-type
83     #:slot-definition-readers
84     #:slot-definition-writers))
85    
86 heller 1.36 (in-package :swank-backend)
87 lgorrie 1.1
88    
89 lgorrie 1.21 ;;;; Metacode
90    
91     (defparameter *interface-functions* '()
92     "The names of all interface functions.")
93    
94     (defparameter *unimplemented-interfaces* '()
95     "List of interface functions that are not implemented.
96     DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
97    
98 heller 1.52 (defmacro definterface (name args documentation &rest default-body)
99 lgorrie 1.21 "Define an interface function for the backend to implement.
100     A generic function is defined with NAME, ARGS, and DOCUMENTATION.
101    
102     If a DEFAULT-BODY is supplied then NO-APPLICABLE-METHOD is specialized
103     to execute the body if the backend doesn't provide a specific
104     implementation.
105    
106     Backends implement these functions using DEFIMPLEMENTATION."
107 lgorrie 1.43 (check-type documentation string "a documentation string")
108 lgorrie 1.21 (flet ((gen-default-impl ()
109 mbaringer 1.73 `(defmethod ,name ,args ,@default-body)))
110 lgorrie 1.48 `(progn (defgeneric ,name ,args (:documentation ,documentation))
111     (pushnew ',name *interface-functions*)
112     ,(if (null default-body)
113     `(pushnew ',name *unimplemented-interfaces*)
114     (gen-default-impl))
115     ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
116     (eval-when (:compile-toplevel :load-toplevel :execute)
117     (export ',name :swank-backend))
118     ',name)))
119 lgorrie 1.21
120     (defmacro defimplementation (name args &body body)
121 heller 1.25 `(progn (defmethod ,name ,args ,@body)
122     (if (member ',name *interface-functions*)
123     (setq *unimplemented-interfaces*
124     (remove ',name *unimplemented-interfaces*))
125     (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
126     ',name))
127 lgorrie 1.21
128     (defun warn-unimplemented-interfaces ()
129     "Warn the user about unimplemented backend features.
130     The portable code calls this function at startup."
131     (warn "These Swank interfaces are unimplemented:~% ~A"
132     (sort (copy-list *unimplemented-interfaces*) #'string<)))
133    
134 heller 1.69 (defun import-to-swank-mop (symbol-list)
135     (dolist (sym symbol-list)
136     (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
137     (when swank-mop-sym
138     (unintern swank-mop-sym :swank-mop))
139     (import sym :swank-mop)
140     (export sym :swank-mop))))
141    
142     (defun import-swank-mop-symbols (package except)
143     "Import the mop symbols from PACKAGE to SWANK-MOP.
144     EXCEPT is a list of symbol names which should be ignored."
145     (do-symbols (s :swank-mop)
146     (unless (member s except :test #'string=)
147     (let ((real-symbol (find-symbol (string s) package)))
148     (assert real-symbol)
149     (unintern s :swank-mop)
150     (import real-symbol :swank-mop)
151     (export real-symbol :swank-mop)))))
152    
153 lgorrie 1.21
154 heller 1.46 ;;;; Utilities
155    
156     (defmacro with-struct ((conc-name &rest names) obj &body body)
157     "Like with-slots but works only for structs."
158     (flet ((reader (slot) (intern (concatenate 'string
159     (symbol-name conc-name)
160     (symbol-name slot))
161     (symbol-package conc-name))))
162     (let ((tmp (gensym "OO-")))
163     ` (let ((,tmp ,obj))
164     (symbol-macrolet
165     ,(loop for name in names collect
166     (typecase name
167     (symbol `(,name (,(reader name) ,tmp)))
168     (cons `(,(first name) (,(reader (second name)) ,tmp)))
169     (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
170     ,@body)))))
171 lgorrie 1.54
172    
173 lgorrie 1.13 ;;;; TCP server
174    
175 heller 1.29 (definterface create-socket (host port)
176     "Create a listening TCP socket on interface HOST and port PORT .")
177 lgorrie 1.13
178 lgorrie 1.21 (definterface local-port (socket)
179     "Return the local port number of SOCKET.")
180 lgorrie 1.1
181 lgorrie 1.21 (definterface close-socket (socket)
182     "Close the socket SOCKET.")
183 lgorrie 1.1
184 heller 1.75 (definterface accept-connection (socket &key external-format)
185 heller 1.16 "Accept a client connection on the listening socket SOCKET. Return
186 lgorrie 1.21 a stream for the new connection.")
187 heller 1.16
188 heller 1.31 (definterface add-sigio-handler (socket fn)
189 lgorrie 1.21 "Call FN whenever SOCKET is readable.")
190 heller 1.16
191 heller 1.31 (definterface remove-sigio-handlers (socket)
192     "Remove all sigio handlers for SOCKET.")
193    
194     (definterface add-fd-handler (socket fn)
195     "Call FN when Lisp is waiting for input and SOCKET is readable.")
196    
197     (definterface remove-fd-handlers (socket)
198     "Remove all fd-handlers for SOCKET.")
199 heller 1.18
200 heller 1.36 (definterface preferred-communication-style ()
201     "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
202     nil)
203    
204 lgorrie 1.13 ;;; Base condition for networking errors.
205 msimmons 1.50 (define-condition network-error (simple-error) ())
206 lgorrie 1.13
207 heller 1.74 (definterface emacs-connected ()
208 lgorrie 1.13 "Hook called when the first connection from Emacs is established.
209     Called from the INIT-FN of the socket server that accepts the
210     connection.
211 lgorrie 1.1
212 lgorrie 1.13 This is intended for setting up extra context, e.g. to discover
213 heller 1.74 that the calling thread is the one that interacts with Emacs."
214 mbaringer 1.73 nil)
215 lgorrie 1.1
216    
217 heller 1.20 ;;;; Unix signals
218    
219     (defconstant +sigint+ 2)
220    
221 heller 1.36 (definterface call-without-interrupts (fn)
222     "Call FN in a context where interrupts are disabled."
223     (funcall fn))
224 heller 1.20
225 heller 1.32 (definterface getpid ()
226     "Return the (Unix) process ID of this superior Lisp.")
227    
228     (definterface lisp-implementation-type-name ()
229     "Return a short name for the Lisp implementation."
230     (lisp-implementation-type))
231 heller 1.20
232 heller 1.51 (definterface default-directory ()
233     "Return the default directory."
234     (directory-namestring (truename *default-pathname-defaults*)))
235    
236 heller 1.39 (definterface set-default-directory (directory)
237     "Set the default directory.
238     This is used to resolve filenames without directory component."
239     (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
240 heller 1.51 (default-directory))
241    
242     (definterface call-with-syntax-hooks (fn)
243     "Call FN with hooks to handle special syntax."
244     (funcall fn))
245 heller 1.39
246 heller 1.52 (definterface default-readtable-alist ()
247     "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
248     '())
249    
250 heller 1.58 (definterface quit-lisp ()
251     "Exit the current lisp image.")
252    
253 heller 1.20
254 lgorrie 1.1 ;;;; Compilation
255 dbarlow 1.8
256 lgorrie 1.21 (definterface call-with-compilation-hooks (func)
257 lgorrie 1.47 "Call FUNC with hooks to record compiler conditions.")
258 lgorrie 1.13
259 vsedach 1.14 (defmacro with-compilation-hooks ((&rest ignore) &body body)
260 lgorrie 1.47 "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
261 vsedach 1.14 (declare (ignore ignore))
262 dbarlow 1.8 `(call-with-compilation-hooks (lambda () (progn ,@body))))
263 lgorrie 1.1
264 pseibel 1.64 (definterface swank-compile-string (string &key buffer position directory)
265 lgorrie 1.47 "Compile source from STRING. During compilation, compiler
266 lgorrie 1.1 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
267    
268     If supplied, BUFFER and POSITION specify the source location in Emacs.
269    
270     Additionally, if POSITION is supplied, it must be added to source
271 pseibel 1.64 positions reported in compiler conditions.
272    
273     If DIRECTORY is specified it may be used by certain implementations to
274     rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
275     source information.")
276 lgorrie 1.1
277 lgorrie 1.43 (definterface operate-on-system (system-name operation-name &rest keyword-args)
278     "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
279     The KEYWORD-ARGS are passed on to the operation.
280     Example:
281     \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
282     (unless (member :asdf *features*)
283     (error "ASDF is not loaded."))
284 heller 1.30 (with-compilation-hooks ()
285 lgorrie 1.43 (let ((operate (find-symbol "OPERATE" :asdf))
286     (operation (find-symbol operation-name :asdf)))
287     (when (null operation)
288     (error "Couldn't find ASDF operation ~S" operation-name))
289     (apply operate operation system-name keyword-args))))
290 mbaringer 1.26
291 heller 1.36 (definterface swank-compile-file (filename load-p)
292 lgorrie 1.1 "Compile FILENAME signalling COMPILE-CONDITIONs.
293 lgorrie 1.21 If LOAD-P is true, load the file after compilation.")
294 lgorrie 1.1
295 heller 1.72 (deftype severity ()
296     '(member :error :read-error :warning :style-warning :note))
297 lgorrie 1.13
298     ;; Base condition type for compiler errors, warnings and notes.
299     (define-condition compiler-condition (condition)
300     ((original-condition
301     ;; The original condition thrown by the compiler if appropriate.
302     ;; May be NIL if a compiler does not report using conditions.
303     :type (or null condition)
304     :initarg :original-condition
305     :accessor original-condition)
306    
307     (severity :type severity
308     :initarg :severity
309     :accessor severity)
310    
311     (message :initarg :message
312     :accessor message)
313    
314 heller 1.30 (short-message :initarg :short-message
315     :initform nil
316     :accessor short-message)
317 crhodes 1.62
318     (references :initarg :references
319     :initform nil
320     :accessor references)
321 heller 1.30
322 lgorrie 1.13 (location :initarg :location
323     :accessor location)))
324 heller 1.30
325 lgorrie 1.17
326 lgorrie 1.13 ;;;; Streams
327    
328 lgorrie 1.21 (definterface make-fn-streams (input-fn output-fn)
329 lgorrie 1.13 "Return character input and output streams backended by functions.
330     When input is needed, INPUT-FN is called with no arguments to
331     return a string.
332     When output is ready, OUTPUT-FN is called with the output as its
333     argument.
334    
335     Output should be forced to OUTPUT-FN before calling INPUT-FN.
336    
337 lgorrie 1.21 The streams are returned as two values.")
338 lgorrie 1.13
339 lgorrie 1.60 (definterface make-stream-interactive (stream)
340     "Do any necessary setup to make STREAM work interactively.
341     This is called for each stream used for interaction with the user
342     \(e.g. *standard-output*). An implementation could setup some
343     implementation-specific functions to control output flushing at the
344     like."
345 mbaringer 1.73 (declare (ignore stream))
346 lgorrie 1.60 nil)
347    
348 lgorrie 1.1
349     ;;;; Documentation
350    
351 heller 1.36 (definterface arglist (name)
352 mbaringer 1.65 "Return the lambda list for the symbol NAME. NAME can also be
353     a lisp function object, on lisps which support this.
354    
355     The result can be a list or the :not-available if the arglist
356     cannot be determined."
357     (declare (ignore name))
358     :not-available)
359 heller 1.36
360 mbaringer 1.65 (definterface function-name (function)
361     "Return the name of the function object FUNCTION.
362    
363     The result is either a symbol, a list, or NIL if no function name is available."
364     (declare (ignore function))
365     nil)
366 lgorrie 1.1
367 lgorrie 1.21 (definterface macroexpand-all (form)
368 lgorrie 1.1 "Recursively expand all macros in FORM.
369 lgorrie 1.21 Return the resulting form.")
370 lgorrie 1.1
371 lgorrie 1.21 (definterface describe-symbol-for-emacs (symbol)
372 lgorrie 1.1 "Return a property list describing SYMBOL.
373    
374     The property list has an entry for each interesting aspect of the
375     symbol. The recognised keys are:
376    
377     :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO
378     :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
379    
380     The value of each property is the corresponding documentation string,
381     or :NOT-DOCUMENTED. It is legal to include keys not listed here.
382    
383     Properties should be included if and only if they are applicable to
384     the symbol. For example, only (and all) fbound symbols should include
385     the :FUNCTION property.
386    
387     Example:
388     \(describe-symbol-for-emacs 'vector)
389     => (:CLASS :NOT-DOCUMENTED
390     :TYPE :NOT-DOCUMENTED
391 lgorrie 1.21 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
392    
393     (definterface describe-definition (name type)
394     "Describe the definition NAME of TYPE.
395     TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
396    
397     Return a documentation string, or NIL if none is available.")
398 lgorrie 1.2
399    
400     ;;;; Debugging
401    
402 lgorrie 1.21 (definterface call-with-debugging-environment (debugger-loop-fn)
403 lgorrie 1.2 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
404    
405     This function is called recursively at each debug level to invoke the
406     debugger loop. The purpose is to setup any necessary environment for
407     other debugger callbacks that will be called within the debugger loop.
408    
409     For example, this is a reasonable place to compute a backtrace, switch
410 lgorrie 1.21 to safe reader/printer settings, and so on.")
411 lgorrie 1.2
412     (define-condition sldb-condition (condition)
413     ((original-condition
414     :initarg :original-condition
415 heller 1.5 :accessor original-condition))
416 heller 1.63 (:report (lambda (condition stream)
417     (format stream "Condition in debugger code~@[: ~A~]"
418     (original-condition condition))))
419 lgorrie 1.2 (:documentation
420     "Wrapper for conditions that should not be debugged.
421    
422     When a condition arises from the internals of the debugger, it is not
423     desirable to debug it -- we'd risk entering an endless loop trying to
424     debug the debugger! Instead, such conditions can be reported to the
425     user without (re)entering the debugger by wrapping them as
426     `sldb-condition's."))
427    
428 heller 1.36 (definterface compute-backtrace (start end)
429 lgorrie 1.3 "Return a list containing a backtrace of the condition current
430     being debugged. The results are unspecified if this function is
431 heller 1.36 called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
432    
433     START and END are zero-based indices constraining the number of frames
434     returned. Frame zero is defined as the frame which invoked the
435     debugger. If END is nil, return the frames from START to the end of
436     the stack.")
437 lgorrie 1.3
438 heller 1.36 (definterface print-frame (frame stream)
439     "Print frame to stream.")
440 lgorrie 1.3
441 heller 1.70 (definterface frame-package (frame)
442     "Return the preferred package to use when printing local variables.
443     NIL can be used if no particular package is known."
444 mbaringer 1.73 (declare (ignore frame))
445 heller 1.70 nil)
446    
447 lgorrie 1.21 (definterface frame-source-location-for-emacs (frame-number)
448     "Return the source location for FRAME-NUMBER.")
449 lgorrie 1.3
450 lgorrie 1.21 (definterface frame-catch-tags (frame-number)
451 lgorrie 1.3 "Return a list of XXX list of what? catch tags for a debugger
452     stack frame. The results are undefined unless this is called
453     within the dynamic contour of a function defined by
454 lgorrie 1.21 DEFINE-DEBUGGER-HOOK.")
455 lgorrie 1.3
456 lgorrie 1.21 (definterface frame-locals (frame-number)
457 heller 1.57 "Return a list of XXX local variable designators define me
458 lgorrie 1.3 for a debugger stack frame. The results are undefined unless
459     this is called within the dynamic contour of a function defined
460 lgorrie 1.21 by DEFINE-DEBUGGER-HOOK.")
461 heller 1.37
462 heller 1.57 (definterface frame-var-value (frame var)
463     "Return the value of VAR in FRAME.
464     FRAME is the number of the frame in the backtrace.
465     VAR is the number of the variable in the frame.")
466    
467 heller 1.37 (definterface disassemble-frame (frame-number)
468     "Disassemble the code for the FRAME-NUMBER.
469     The output should be written to standard output.
470     FRAME-NUMBER is a non-negative interger.")
471    
472 lgorrie 1.21 (definterface eval-in-frame (form frame-number)
473 lgorrie 1.3 "Evaluate a Lisp form in the lexical context of a stack frame
474     in the debugger. The results are undefined unless called in the
475     dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
476    
477     FRAME-NUMBER must be a positive integer with 0 indicating the
478     frame which invoked the debugger.
479    
480     The return value is the result of evaulating FORM in the
481 lgorrie 1.21 appropriate context.")
482 heller 1.22
483     (definterface return-from-frame (frame-number form)
484     "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
485     produced by evaluating FORM in the frame context to its caller.
486    
487     Execute any clean-up code from unwind-protect forms above the frame
488     during unwinding.
489    
490     Return a string describing the error if it's not possible to return
491     from the frame.")
492    
493     (definterface restart-frame (frame-number)
494     "Restart execution of the frame FRAME-NUMBER with the same arguments
495     as it was called originally.")
496 lgorrie 1.3
497 lgorrie 1.49 (definterface format-sldb-condition (condition)
498     "Format a condition for display in SLDB."
499     (princ-to-string condition))
500    
501     (definterface condition-references (condition)
502     "Return a list of documentation references for a condition.
503     Each reference is one of:
504     (:ANSI-CL
505     {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY }
506     symbol-or-name)
507     (:SBCL :NODE node-name)"
508 mbaringer 1.73 (declare (ignore condition))
509 lgorrie 1.49 '())
510 heller 1.52
511 heller 1.69 (definterface condition-extras (condition)
512     "Return a list of extra for the debugger.
513     The allowed elements are of the form:
514     (:SHOW-FRAME-SOURCE frame-number)"
515 mbaringer 1.73 (declare (ignore condition))
516 heller 1.69 '())
517    
518 heller 1.71 (definterface activate-stepping (frame-number)
519     "Prepare the frame FRAME-NUMBER for stepping.")
520 heller 1.69
521     (definterface sldb-break-on-return (frame-number)
522     "Set a breakpoint in the frame FRAME-NUMBER.")
523    
524     (definterface sldb-break-at-start (symbol)
525     "Set a breakpoint on the beginning of the function for SYMBOL.")
526 heller 1.52
527 lgorrie 1.49
528 lgorrie 1.3
529 heller 1.36 ;;;; Definition finding
530    
531     (defstruct (:location (:type list) :named
532 lgorrie 1.45 (:constructor make-location
533     (buffer position &optional hints)))
534     buffer position
535     ;; Hints is a property list optionally containing:
536     ;; :snippet SOURCE-TEXT
537     ;; This is a snippet of the actual source text at the start of
538     ;; the definition, which could be used in a text search.
539     hints)
540 heller 1.36
541     (defstruct (:error (:type list) :named (:constructor)) message)
542     (defstruct (:file (:type list) :named (:constructor)) name)
543     (defstruct (:buffer (:type list) :named (:constructor)) name)
544     (defstruct (:position (:type list) :named (:constructor)) pos)
545    
546     (definterface find-definitions (name)
547     "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
548    
549 heller 1.38 NAME is a \"definition specifier\".
550 heller 1.36
551 heller 1.38 DSPEC is a \"definition specifier\" describing the
552 heller 1.36 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
553 heller 1.38 \(DEFVAR FOO).
554    
555     LOCATION is the source location for the definition.")
556 heller 1.36
557 lgorrie 1.61 (definterface buffer-first-change (filename)
558     "Called for effect the first time FILENAME's buffer is modified."
559 mbaringer 1.73 (declare (ignore filename))
560 lgorrie 1.61 nil)
561    
562 heller 1.36
563     ;;;; XREF
564    
565     (definterface who-calls (function-name)
566     "Return the call sites of FUNCTION-NAME (a symbol).
567     The results is a list ((DSPEC LOCATION) ...).")
568    
569     (definterface who-references (variable-name)
570     "Return the locations where VARIABLE-NAME (a symbol) is referenced.
571     See WHO-CALLS for a description of the return value.")
572    
573     (definterface who-binds (variable-name)
574     "Return the locations where VARIABLE-NAME (a symbol) is bound.
575     See WHO-CALLS for a description of the return value.")
576    
577     (definterface who-sets (variable-name)
578     "Return the locations where VARIABLE-NAME (a symbol) is set.
579     See WHO-CALLS for a description of the return value.")
580    
581     (definterface who-macroexpands (macro-name)
582     "Return the locations where MACRO-NAME (a symbol) is expanded.
583     See WHO-CALLS for a description of the return value.")
584    
585     (definterface who-specializes (class-name)
586     "Return the locations where CLASS-NAME (a symbol) is specialized.
587     See WHO-CALLS for a description of the return value.")
588    
589     ;;; Simpler variants.
590    
591     (definterface list-callers (function-name)
592     "List the callers of FUNCTION-NAME.
593     This function is like WHO-CALLS except that it is expected to use
594     lower-level means. Whereas WHO-CALLS is usually implemented with
595     special compiler support, LIST-CALLERS is usually implemented by
596     groveling for constants in function objects throughout the heap.
597    
598     The return value is as for WHO-CALLS.")
599    
600     (definterface list-callees (function-name)
601     "List the functions called by FUNCTION-NAME.
602     See LIST-CALLERS for a description of the return value.")
603    
604    
605 heller 1.23 ;;;; Profiling
606    
607     ;;; The following functions define a minimal profiling interface.
608    
609     (definterface profile (fname)
610     "Marks symbol FNAME for profiling.")
611    
612     (definterface profiled-functions ()
613     "Returns a list of profiled functions.")
614    
615     (definterface unprofile (fname)
616     "Marks symbol FNAME as not profiled.")
617    
618     (definterface unprofile-all ()
619     "Marks all currently profiled functions as not profiled."
620     (dolist (f (profiled-functions))
621     (unprofile f)))
622    
623     (definterface profile-report ()
624     "Prints profile report.")
625    
626     (definterface profile-reset ()
627     "Resets profile counters.")
628    
629     (definterface profile-package (package callers-p methods)
630     "Wrap profiling code around all functions in PACKAGE. If a function
631     is already profiled, then unprofile and reprofile (useful to notice
632     function redefinition.)
633    
634     If CALLERS-P is T names have counts of the most common calling
635     functions recorded.
636    
637     When called with arguments :METHODS T, profile all methods of all
638     generic functions having names in the given package. Generic functions
639     themselves, that is, their dispatch functions, are left alone.")
640    
641    
642 heller 1.19 ;;;; Inspector
643 lgorrie 1.56
644 mbaringer 1.67 (defclass inspector ()
645     ()
646     (:documentation "Super class of inspector objects.
647    
648     Implementations should sub class in order to dispatch off of the
649     inspect-for-emacs method."))
650    
651     (definterface make-default-inspector ()
652     "Return an inspector object suitable for passing to inspect-for-emacs.")
653    
654     (definterface inspect-for-emacs (object inspector)
655     "Explain to emacs how to inspect OBJECT.
656    
657     The argument INSPECTOR is an object representing how to get at
658     the internals of OBJECT, it is usually an implementation specific
659     class used simply for dispatching to the proper method.
660    
661     The orgument INSPECTION-MODE is an object specifying how, and
662     what, to show to the user.
663    
664     Returns two values: a string which will be used as the title of
665     the inspector buffer and a list specifying how to render the
666     object for inspection.
667    
668     Every elementi of the list must be either a string, which will be
669     inserted into the buffer as is, or a list of the form:
670    
671     (:value object &optional format) - Render an inspectable
672     object. If format is provided it must be a string and will be
673     rendered in place of the value, otherwise use princ-to-string.
674    
675     (:newline) - Render a \\n
676    
677     (:action label lambda) - Render LABEL (a text string) which when
678     clicked will call LAMBDA.
679    
680     NIL - do nothing.")
681    
682 mbaringer 1.73 (defmethod inspect-for-emacs ((object t) (inspector t))
683 mbaringer 1.67 "Generic method for inspecting any kind of object.
684    
685     Since we don't know how to deal with OBJECT we simply dump the
686     output of CL:DESCRIBE."
687 mbaringer 1.73 (declare (ignore inspector))
688 mbaringer 1.67 (values "A value."
689     `("Type: " (:value ,(type-of object))
690     (:newline)
691     "Don't know how to inspect the object, dumping output of CL:DESCIRBE:"
692     (:newline) (:newline)
693     ,(with-output-to-string (desc)
694     (describe object desc)))))
695 heller 1.70
696     ;;; Utilities to for inspector methods.
697     ;;;
698     (defun label-value-line (label value)
699     "Create a control list which prints \"LABEL: VALUE\" in the inspector."
700     (list (princ-to-string label) ": " `(:value ,value) '(:newline)))
701    
702     (defmacro label-value-line* (&rest label-values)
703     ` (append ,@(loop for (label value) in label-values
704     collect `(label-value-line ,label ,value))))
705 heller 1.19
706 heller 1.29 (definterface describe-primitive-type (object)
707 heller 1.35 "Return a string describing the primitive type of object."
708 heller 1.36 (declare (ignore object))
709 heller 1.35 "N/A")
710 heller 1.19
711    
712 heller 1.36 ;;;; Multithreading
713 lgorrie 1.21 ;;;
714     ;;; The default implementations are sufficient for non-multiprocessing
715     ;;; implementations.
716 lgorrie 1.9
717 lgorrie 1.21 (definterface startup-multiprocessing ()
718 lgorrie 1.9 "Initialize multiprocessing, if necessary.
719    
720     This function is called directly through the listener, not in an RPC
721     from Emacs. This is to support interfaces such as CMUCL's
722     MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
723 lgorrie 1.21 normal function."
724     nil)
725 lgorrie 1.9
726 lgorrie 1.21 (definterface spawn (fn &key name)
727     "Create a new thread to call FN.")
728 lgorrie 1.17
729 heller 1.58 (definterface thread-id (thread)
730     "Return an Emacs-parsable object to identify THREAD.
731    
732     Ids should be comparable with equal, i.e.:
733     (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")
734    
735     (definterface find-thread (id)
736     "Return the thread for ID.
737     ID should be an id previously obtained with THREAD-ID.
738     Can return nil if the thread no longer exists.")
739    
740 heller 1.28 (definterface thread-name (thread)
741     "Return the name of THREAD.
742 lgorrie 1.9
743     Thread names are be single-line strings and are meaningful to the
744 lgorrie 1.21 user. They do not have to be unique."
745 heller 1.28 (declare (ignore thread))
746 lgorrie 1.21 "The One True Thread")
747 lgorrie 1.9
748 heller 1.28 (definterface thread-status (thread)
749     "Return a string describing THREAD's state."
750     (declare (ignore thread))
751     "")
752    
753 lgorrie 1.21 (definterface make-lock (&key name)
754 lgorrie 1.17 "Make a lock for thread synchronization.
755 lgorrie 1.21 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
756 heller 1.23 (declare (ignore name))
757 lgorrie 1.21 :null-lock)
758 lgorrie 1.9
759 lgorrie 1.21 (definterface call-with-lock-held (lock function)
760     "Call FUNCTION with LOCK held, queueing if necessary."
761 heller 1.24 (declare (ignore lock)
762     (type function function))
763 lgorrie 1.21 (funcall function))
764 heller 1.25
765     (definterface current-thread ()
766     "Return the currently executing thread."
767     0)
768 heller 1.28
769     (definterface all-threads ()
770     "Return a list of all threads.")
771    
772     (definterface thread-alive-p (thread)
773 heller 1.35 "Test if THREAD is termintated."
774     (member thread (all-threads)))
775 heller 1.25
776     (definterface interrupt-thread (thread fn)
777     "Cause THREAD to execute FN.")
778    
779 mbaringer 1.34 (definterface kill-thread (thread)
780     "Kill THREAD."
781     (declare (ignore thread))
782     nil)
783    
784 heller 1.25 (definterface send (thread object)
785     "Send OBJECT to thread THREAD.")
786    
787     (definterface receive ()
788     "Return the next message from current thread's mailbox.")

  ViewVC Help
Powered by ViewVC 1.1.5