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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


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

  ViewVC Help
Powered by ViewVC 1.1.5