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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.140 - (hide annotations)
Wed Aug 6 19:51:29 2008 UTC (5 years, 8 months ago) by heller
Branch: MAIN
Changes since 1.139: +13 -0 lines
Queue interrupts in various places.

* swank-backend.lisp (*pending-slime-interrupts*): New variable.
(check-slime-interrupts): New function.

* swank-lispworks.lisp (receive-if): Use it.

* swank-sbcl.lisp, swank-openmcl.lisp: Ditto.

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

  ViewVC Help
Powered by ViewVC 1.1.5