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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.128 - (hide annotations)
Sat Feb 9 18:38:58 2008 UTC (6 years, 2 months ago) by heller
Branch: MAIN
Changes since 1.127: +3 -7 lines
Inspector cleanups.

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

  ViewVC Help
Powered by ViewVC 1.1.5