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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5