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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.138 - (hide annotations)
Tue Aug 5 17:38:44 2008 UTC (5 years, 8 months ago) by heller
Branch: MAIN
Changes since 1.137: +2 -19 lines
Drop distinction between "recursive" and non-recursive locks.

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

  ViewVC Help
Powered by ViewVC 1.1.5