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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.134 - (hide annotations)
Thu Jul 17 22:19:12 2008 UTC (5 years, 9 months ago) by trittweiler
Branch: MAIN
Changes since 1.133: +3 -2 lines
	An explicit numeric value as prefix-arg given to `C-c C-c' will
	now represent the debug level the defun is compiled with;
	`C-u C-c C-c' defaults to maximum debug like before. (Now also
	works for recompilation commands in xref buffers.)

	* slime.el (slime-compilation-debug-level): Renamed from
	`slime-compile-with-maximum-debug'.
	(slime-normalize-optimization-level): New.
	(slime-compile-defun): Adapted accordingly.
	(slime-compile-region): Ditto.
	(slime-recompile-location): Added setting of debug-level.
	(slime-recompile-locations): Ditto.
	(slime-recompile-xref): Now takes debug-level prefix-arg.
	(slime-recompile-all-xrefs): Ditto.

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

  ViewVC Help
Powered by ViewVC 1.1.5