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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.126 - (hide annotations)
Mon Sep 10 15:39:05 2007 UTC (6 years, 7 months ago) by heller
Branch: MAIN
Changes since 1.125: +3 -11 lines
Move SBCL doc references to contrib.

* slime.el (sldb-insert-condition): Merge REFERENCES and EXTRAS.
(sldb-extras-hooks, sldb-dispatch-extras): New hook.

* swank.lisp (debugger-condition-for-emacs): Merge REFERENCES and EXTRAS.

* swank-backend.lisp (condition-references): Removed. Merged with
condition-extras.

* swank-sbcl.lisp (condition-references): Removed.
(condition-extras): Include references.
(externalize-reference): New function.  Don't return plain
symbols.

* swank-allegro.lisp (condition-references): Removed.

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

  ViewVC Help
Powered by ViewVC 1.1.5