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

Diff of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.36 by heller, Tue Mar 9 12:46:27 2004 UTC revision 1.94 by heller, Sun Nov 20 23:25:38 2005 UTC
# Line 1  Line 1 
1  ;;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-  ;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
2  ;;;  ;;;
3  ;;; slime-backend.lisp --- SLIME backend interface.  ;;; slime-backend.lisp --- SLIME backend interface.
4  ;;;  ;;;
5  ;;; Created by James Bielman in 2003. Released into the public domain.  ;;; Created by James Bielman in 2003. Released into the public domain.
6  ;;;  ;;;
7    ;;;; Frontmatter
8    ;;;
9  ;;; This file defines the functions that must be implemented  ;;; This file defines the functions that must be implemented
10  ;;; separately for each Lisp. Each is declared as a generic function  ;;; separately for each Lisp. Each is declared as a generic function
11  ;;; for which swank-<implementation>.lisp provides methods.  ;;; for which swank-<implementation>.lisp provides methods.
# Line 24  Line 26 
26             #:position-p             #:position-p
27             #:position-pos             #:position-pos
28             #:print-output-to-string             #:print-output-to-string
29               #:quit-lisp
30               #:references
31               #:unbound-slot-filler
32               ;; inspector related symbols
33               #:inspector
34               #:inspect-for-emacs
35               #:raw-inspection
36               #:fancy-inspection
37               #:label-value-line
38               #:label-value-line*
39             ))             ))
40    
41    (defpackage :swank-mop
42      (:use)
43      (:export
44       ;; classes
45       #:standard-generic-function
46       #:standard-slot-definition
47       #:standard-method
48       #:standard-class
49       #:eql-specializer
50       #:eql-specializer-object
51       ;; standard-class readers
52       #:class-default-initargs
53       #:class-direct-default-initargs
54       #:class-direct-slots
55       #:class-direct-subclasses
56       #:class-direct-superclasses
57       #:class-finalized-p
58       #:class-name
59       #:class-precedence-list
60       #:class-prototype
61       #:class-slots
62       #:specializer-direct-methods
63       ;; generic function readers
64       #:generic-function-argument-precedence-order
65       #:generic-function-declarations
66       #:generic-function-lambda-list
67       #:generic-function-methods
68       #:generic-function-method-class
69       #:generic-function-method-combination
70       #:generic-function-name
71       ;; method readers
72       #:method-generic-function
73       #:method-function
74       #:method-lambda-list
75       #:method-specializers
76       #:method-qualifiers
77       ;; slot readers
78       #:slot-definition-allocation
79       #:slot-definition-documentation
80       #:slot-definition-initargs
81       #:slot-definition-initform
82       #:slot-definition-initfunction
83       #:slot-definition-name
84       #:slot-definition-type
85       #:slot-definition-readers
86       #:slot-definition-writers
87       ;; generic function protocol
88       #:compute-applicable-methods-using-classes
89       #:finalize-inheritance))
90    
91  (in-package :swank-backend)  (in-package :swank-backend)
92    
93    
# Line 38  Line 100 
100    "List of interface functions that are not implemented.    "List of interface functions that are not implemented.
101  DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")  DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
102    
103  (defmacro definterface (name args documentation &body default-body)  (defmacro definterface (name args documentation &rest default-body)
104    "Define an interface function for the backend to implement.    "Define an interface function for the backend to implement.
105  A generic function is defined with NAME, ARGS, and DOCUMENTATION.  A generic function is defined with NAME, ARGS, and DOCUMENTATION.
106    
# Line 47  to execute the body if the backend doesn Line 109  to execute the body if the backend doesn
109  implementation.  implementation.
110    
111  Backends implement these functions using DEFIMPLEMENTATION."  Backends implement these functions using DEFIMPLEMENTATION."
112      (check-type documentation string "a documentation string")
113    (flet ((gen-default-impl ()    (flet ((gen-default-impl ()
114             (let ((received-args (gensym "ARGS-")))             `(defmethod ,name ,args ,@default-body)))
115               `(defmethod no-applicable-method ((#:method      `(progn (defgeneric ,name ,args (:documentation ,documentation))
116                                                  (eql (function ,name)))              (pushnew ',name *interface-functions*)
117                                                 &rest ,received-args)              ,(if (null default-body)
118                 (destructuring-bind ,args ,received-args                   `(pushnew ',name *unimplemented-interfaces*)
119                   ,@default-body)))))                   (gen-default-impl))
120       ` (progn (defgeneric ,name ,args (:documentation ,documentation))              ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
121                (pushnew ',name *interface-functions*)              (eval-when (:compile-toplevel :load-toplevel :execute)
122                ,(if (null default-body)                (export ',name :swank-backend))
123                     `(pushnew ',name *unimplemented-interfaces*)              ',name)))
                    (gen-default-impl))  
               (export ',name :swank-backend)  
               ',name)))  
124    
125  (defmacro defimplementation (name args &body body)  (defmacro defimplementation (name args &body body)
   ;; Is this a macro no-no -- should it be pushed out of macroexpansion?  
126    `(progn (defmethod ,name ,args ,@body)    `(progn (defmethod ,name ,args ,@body)
127            (if (member ',name *interface-functions*)            (if (member ',name *interface-functions*)
128                (setq *unimplemented-interfaces*                (setq *unimplemented-interfaces*
# Line 77  The portable code calls this function at Line 136  The portable code calls this function at
136    (warn "These Swank interfaces are unimplemented:~% ~A"    (warn "These Swank interfaces are unimplemented:~% ~A"
137          (sort (copy-list *unimplemented-interfaces*) #'string<)))          (sort (copy-list *unimplemented-interfaces*) #'string<)))
138    
139    (defun import-to-swank-mop (symbol-list)
140      (dolist (sym symbol-list)
141        (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
142          (when swank-mop-sym
143            (unintern swank-mop-sym :swank-mop))
144          (import sym :swank-mop)
145          (export sym :swank-mop))))
146    
147    (defun import-swank-mop-symbols (package except)
148      "Import the mop symbols from PACKAGE to SWANK-MOP.
149    EXCEPT is a list of symbol names which should be ignored."
150      (do-symbols (s :swank-mop)
151        (unless (member s except :test #'string=)
152          (let ((real-symbol (find-symbol (string s) package)))
153            (assert real-symbol () "Symbol ~A not found in package ~A" s package)
154            (unintern s :swank-mop)
155            (import real-symbol :swank-mop)
156            (export real-symbol :swank-mop)))))
157    
158    (defvar *gray-stream-symbols*
159      '(:fundamental-character-output-stream
160        :stream-write-char
161        :stream-fresh-line
162        :stream-force-output
163        :stream-finish-output
164        :fundamental-character-input-stream
165        :stream-read-char
166        :stream-listen
167        :stream-unread-char
168        :stream-clear-input
169        :stream-line-column
170        :stream-read-char-no-hang
171        ;; STREAM-LINE-LENGTH is an extension to gray streams that's apparently
172        ;; supported by CMUCL, OpenMCL, SBCL and SCL.
173        #+(or cmu openmcl sbcl scl)
174        :stream-line-length))
175    
176    (defun import-from (package symbol-names &optional (to-package *package*))
177      "Import the list of SYMBOL-NAMES found in the package PACKAGE."
178      (dolist (name symbol-names)
179        (multiple-value-bind (symbol found) (find-symbol (string name) package)
180          (assert found () "Symbol ~A not found in package ~A" name package)
181          (import symbol to-package))))
182    
183    
184    ;;;; Utilities
185    
186    (defmacro with-struct ((conc-name &rest names) obj &body body)
187      "Like with-slots but works only for structs."
188      (flet ((reader (slot) (intern (concatenate 'string
189                                                 (symbol-name conc-name)
190                                                 (symbol-name slot))
191                                    (symbol-package conc-name))))
192        (let ((tmp (gensym "OO-")))
193        ` (let ((,tmp ,obj))
194            (symbol-macrolet
195                ,(loop for name in names collect
196                       (typecase name
197                         (symbol `(,name (,(reader name) ,tmp)))
198                         (cons `(,(first name) (,(reader (second name)) ,tmp)))
199                         (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
200              ,@body)))))
201    
202    
203  ;;;; TCP server  ;;;; TCP server
204    
# Line 89  The portable code calls this function at Line 211  The portable code calls this function at
211  (definterface close-socket (socket)  (definterface close-socket (socket)
212    "Close the socket SOCKET.")    "Close the socket SOCKET.")
213    
214  (definterface accept-connection (socket)  (definterface accept-connection (socket &key external-format
215     "Accept a client connection on the listening socket SOCKET.  Return                                          buffering)
216  a stream for the new connection.")     "Accept a client connection on the listening socket SOCKET.
217    Return a stream for the new connection.")
218    
219  (definterface add-sigio-handler (socket fn)  (definterface add-sigio-handler (socket fn)
220    "Call FN whenever SOCKET is readable.")    "Call FN whenever SOCKET is readable.")
# Line 110  a stream for the new connection.") Line 233  a stream for the new connection.")
233    nil)    nil)
234    
235  ;;; Base condition for networking errors.  ;;; Base condition for networking errors.
236  (define-condition network-error (error) ())  (define-condition network-error (simple-error) ())
237    
238  (definterface emacs-connected ()  (definterface emacs-connected ()
239     "Hook called when the first connection from Emacs is established.     "Hook called when the first connection from Emacs is established.
# Line 137  that the calling thread is the one that Line 260  that the calling thread is the one that
260    "Return a short name for the Lisp implementation."    "Return a short name for the Lisp implementation."
261    (lisp-implementation-type))    (lisp-implementation-type))
262    
263    (definterface default-directory ()
264      "Return the default directory."
265      (directory-namestring (truename *default-pathname-defaults*)))
266    
267    (definterface set-default-directory (directory)
268      "Set the default directory.
269    This is used to resolve filenames without directory component."
270      (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
271      (default-directory))
272    
273    (definterface call-with-syntax-hooks (fn)
274      "Call FN with hooks to handle special syntax."
275      (funcall fn))
276    
277    (definterface default-readtable-alist ()
278      "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
279      '())
280    
281    (definterface quit-lisp ()
282      "Exit the current lisp image.")
283    
284    
285  ;;;; Compilation  ;;;; Compilation
286    
287  (definterface call-with-compilation-hooks (func)  (definterface call-with-compilation-hooks (func)
288     "Call FUNC with hooks to trigger SLDB on compiler errors.")    "Call FUNC with hooks to record compiler conditions.")
289    
290  (defmacro with-compilation-hooks ((&rest ignore) &body body)  (defmacro with-compilation-hooks ((&rest ignore) &body body)
291      "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
292    (declare (ignore ignore))    (declare (ignore ignore))
293    `(call-with-compilation-hooks (lambda () (progn ,@body))))    `(call-with-compilation-hooks (lambda () (progn ,@body))))
294    
295  (definterface swank-compile-string (string &key buffer position)  (definterface swank-compile-string (string &key buffer position directory)
296     "Compile source from STRING.  During compilation, compiler    "Compile source from STRING.  During compilation, compiler
297  conditions must be trapped and resignalled as COMPILER-CONDITIONs.  conditions must be trapped and resignalled as COMPILER-CONDITIONs.
298    
299  If supplied, BUFFER and POSITION specify the source location in Emacs.  If supplied, BUFFER and POSITION specify the source location in Emacs.
300    
301  Additionally, if POSITION is supplied, it must be added to source  Additionally, if POSITION is supplied, it must be added to source
302  positions reported in compiler conditions.")  positions reported in compiler conditions.
303    
304  (definterface swank-compile-system (system-name)  If DIRECTORY is specified it may be used by certain implementations to
305    "Compile and load SYSTEM-NAME, During compilation compiler  rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
306    conditions must be trapped and resignalled as  source information.")
307    COMPILER-CONDITION ala compile-string-for-emacs."  
308    (definterface operate-on-system (system-name operation-name &rest keyword-args)
309      "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
310    The KEYWORD-ARGS are passed on to the operation.
311    Example:
312    \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
313      (unless (member :asdf *features*)
314        (error "ASDF is not loaded."))
315    (with-compilation-hooks ()    (with-compilation-hooks ()
316      (cond ((member :asdf *features*)      (let ((operate (find-symbol "OPERATE" :asdf))
317             (let ((operate (find-symbol (string :operate) :asdf))            (operation (find-symbol operation-name :asdf)))
318                   (load-op (find-symbol (string :load-op) :asdf)))        (when (null operation)
319               (funcall operate load-op system-name)))          (error "Couldn't find ASDF operation ~S" operation-name))
320            (t (error "ASDF not loaded")))))        (apply operate operation system-name keyword-args))))
321    
322  (definterface swank-compile-file (filename load-p)  (definterface swank-compile-file (filename load-p &optional external-format)
323     "Compile FILENAME signalling COMPILE-CONDITIONs.     "Compile FILENAME signalling COMPILE-CONDITIONs.
324  If LOAD-P is true, load the file after compilation.")  If LOAD-P is true, load the file after compilation.")
325    
326  (deftype severity () '(member :error :warning :style-warning :note))  (deftype severity ()
327      '(member :error :read-error :warning :style-warning :note))
328    
329  ;; Base condition type for compiler errors, warnings and notes.  ;; Base condition type for compiler errors, warnings and notes.
330  (define-condition compiler-condition (condition)  (define-condition compiler-condition (condition)
# Line 193  If LOAD-P is true, load the file after c Line 346  If LOAD-P is true, load the file after c
346                    :initform nil                    :initform nil
347                    :accessor short-message)                    :accessor short-message)
348    
349       (references :initarg :references
350                   :initform nil
351                   :accessor references)
352    
353     (location :initarg :location     (location :initarg :location
354               :accessor location)))               :accessor location)))
355    
   
   
356    
357  ;;;; Streams  ;;;; Streams
358    
# Line 212  Output should be forced to OUTPUT-FN bef Line 367  Output should be forced to OUTPUT-FN bef
367    
368  The streams are returned as two values.")  The streams are returned as two values.")
369    
370    (definterface make-stream-interactive (stream)
371      "Do any necessary setup to make STREAM work interactively.
372    This is called for each stream used for interaction with the user
373    \(e.g. *standard-output*). An implementation could setup some
374    implementation-specific functions to control output flushing at the
375    like."
376      (declare (ignore stream))
377      nil)
378    
379    
380  ;;;; Documentation  ;;;; Documentation
381    
382  (definterface arglist (name)  (definterface arglist (name)
383     "Return the lambda list for the symbol NAME.     "Return the lambda list for the symbol NAME. NAME can also be
384    a lisp function object, on lisps which support this.
385    
386  The result can be a list or a string.  The result can be a list or the :not-available if the arglist
387    cannot be determined."
388       (declare (ignore name))
389       :not-available)
390    
391    (definterface function-name (function)
392      "Return the name of the function object FUNCTION.
393    
394  An error should be signaled if the lambda list cannot be found.")  The result is either a symbol, a list, or NIL if no function name is available."
395      (declare (ignore function))
396      nil)
397    
398  (definterface macroexpand-all (form)  (definterface macroexpand-all (form)
399     "Recursively expand all macros in FORM.     "Recursively expand all macros in FORM.
400  Return the resulting form.")  Return the resulting form.")
401    
402    (definterface compiler-macroexpand-1 (form &optional env)
403      "Call the compiler-macro for form.
404    If FORM is a function call for which a compiler-macro has been
405    defined, invoke the expander function using *macroexpand-hook* and
406    return the results and T.  Otherwise, return the original form and
407    NIL."
408      (let ((fun (and (consp form) (compiler-macro-function (car form)))))
409        (if fun
410            (let ((result (funcall *macroexpand-hook* fun form env)))
411              (values result (not (eq result form))))
412            (values form nil))))
413    
414    (definterface compiler-macroexpand (form &optional env)
415      "Repetitively call `compiler-macroexpand-1'."
416      (labels ((frob (form expanded)
417                 (multiple-value-bind (new-form newly-expanded)
418                     (compiler-macroexpand-1 form env)
419                   (if newly-expanded
420                       (frob new-form t)
421                       (values new-form expanded)))))
422        (frob form env)))
423    
424  (definterface describe-symbol-for-emacs (symbol)  (definterface describe-symbol-for-emacs (symbol)
425     "Return a property list describing SYMBOL.     "Return a property list describing SYMBOL.
426    
427  The property list has an entry for each interesting aspect of the  The property list has an entry for each interesting aspect of the
428  symbol. The recognised keys are:  symbol. The recognised keys are:
429    
430    :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO    :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
431    :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM    :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
432    
433  The value of each property is the corresponding documentation string,  The value of each property is the corresponding documentation string,
434  or :NOT-DOCUMENTED. It is legal to include keys not listed here.  or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
435    slime-print-apropos in Emacs must know about them).
436    
437  Properties should be included if and only if they are applicable to  Properties should be included if and only if they are applicable to
438  the symbol. For example, only (and all) fbound symbols should include  the symbol. For example, only (and all) fbound symbols should include
# Line 257  Return a documentation string, or NIL if Line 453  Return a documentation string, or NIL if
453    
454  ;;;; Debugging  ;;;; Debugging
455    
456    (definterface install-debugger-globally (function)
457      "Install FUNCTION as the debugger for all threads/processes. This
458    usually involves setting *DEBUGGER-HOOK* and, if the implementation
459    permits, hooking into BREAK as well."
460      (setq *debugger-hook* function))
461    
462  (definterface call-with-debugging-environment (debugger-loop-fn)  (definterface call-with-debugging-environment (debugger-loop-fn)
463     "Call DEBUGGER-LOOP-FN in a suitable debugging environment.     "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
464    
# Line 267  other debugger callbacks that will be ca Line 469  other debugger callbacks that will be ca
469  For example, this is a reasonable place to compute a backtrace, switch  For example, this is a reasonable place to compute a backtrace, switch
470  to safe reader/printer settings, and so on.")  to safe reader/printer settings, and so on.")
471    
472    (definterface call-with-debugger-hook (hook fun)
473      "Call FUN and use HOOK as debugger hook.
474    
475    HOOK should be called for both BREAK and INVOKE-DEBUGGER."
476      (let ((*debugger-hook* hook))
477        (funcall fun)))
478    
479  (define-condition sldb-condition (condition)  (define-condition sldb-condition (condition)
480    ((original-condition    ((original-condition
481      :initarg :original-condition      :initarg :original-condition
482      :accessor original-condition))      :accessor original-condition))
483      (:report (lambda (condition stream)
484                 (format stream "Condition in debugger code~@[: ~A~]"
485                         (original-condition condition))))
486    (:documentation    (:documentation
487     "Wrapper for conditions that should not be debugged.     "Wrapper for conditions that should not be debugged.
488    
# Line 303  within the dynamic contour of a function Line 515  within the dynamic contour of a function
515  DEFINE-DEBUGGER-HOOK.")  DEFINE-DEBUGGER-HOOK.")
516    
517  (definterface frame-locals (frame-number)  (definterface frame-locals (frame-number)
518     "Return a list of XXX local variable designators define me    "Return a list of XXX local variable designators define me
519  for a debugger stack frame.  The results are undefined unless  for a debugger stack frame.  The results are undefined unless
520  this is called within the dynamic contour of a function defined  this is called within the dynamic contour of a function defined
521  by DEFINE-DEBUGGER-HOOK.")  by DEFINE-DEBUGGER-HOOK.")
522    
523    (definterface frame-var-value (frame var)
524      "Return the value of VAR in FRAME.
525    FRAME is the number of the frame in the backtrace.
526    VAR is the number of the variable in the frame.")
527    
528    (definterface disassemble-frame (frame-number)
529      "Disassemble the code for the FRAME-NUMBER.
530    The output should be written to standard output.
531    FRAME-NUMBER is a non-negative integer.")
532    
533  (definterface eval-in-frame (form frame-number)  (definterface eval-in-frame (form frame-number)
534     "Evaluate a Lisp form in the lexical context of a stack frame     "Evaluate a Lisp form in the lexical context of a stack frame
535  in the debugger.  The results are undefined unless called in the  in the debugger.  The results are undefined unless called in the
# Line 333  from the frame.") Line 555  from the frame.")
555    "Restart execution of the frame FRAME-NUMBER with the same arguments    "Restart execution of the frame FRAME-NUMBER with the same arguments
556  as it was called originally.")  as it was called originally.")
557    
558    (definterface format-sldb-condition (condition)
559      "Format a condition for display in SLDB."
560      (princ-to-string condition))
561    
562    (definterface condition-references (condition)
563      "Return a list of documentation references for a condition.
564    Each reference is one of:
565      (:ANSI-CL
566       {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY }
567       symbol-or-name)
568      (:SBCL :NODE node-name)"
569      (declare (ignore condition))
570      '())
571    
572    (definterface condition-extras (condition)
573      "Return a list of extra for the debugger.
574    The allowed elements are of the form:
575      (:SHOW-FRAME-SOURCE frame-number)"
576      (declare (ignore condition))
577      '())
578    
579    (definterface activate-stepping (frame-number)
580      "Prepare the frame FRAME-NUMBER for stepping.")
581    
582    (definterface sldb-break-on-return (frame-number)
583      "Set a breakpoint in the frame FRAME-NUMBER.")
584    
585    (definterface sldb-break-at-start (symbol)
586      "Set a breakpoint on the beginning of the function for SYMBOL.")
587    
588    
589    
590  ;;;; Definition finding  ;;;; Definition finding
591    
592  (defstruct (:location (:type list) :named  (defstruct (:location (:type list) :named
593                        (:constructor make-location (buffer position)))                        (:constructor make-location
594    buffer position)                                      (buffer position &optional hints)))
595      buffer position
596      ;; Hints is a property list optionally containing:
597      ;;   :snippet SOURCE-TEXT
598      ;;     This is a snippet of the actual source text at the start of
599      ;;     the definition, which could be used in a text search.
600      hints)
601    
602  (defstruct (:error (:type list) :named (:constructor)) message)  (defstruct (:error (:type list) :named (:constructor)) message)
603  (defstruct (:file (:type list) :named (:constructor)) name)  (defstruct (:file (:type list) :named (:constructor)) name)
# Line 348  as it was called originally.") Line 607  as it was called originally.")
607  (definterface find-definitions (name)  (definterface find-definitions (name)
608     "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.     "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
609    
610  NAME is string denoting a symbol or \"definition specifier\".  NAME is a \"definition specifier\".
611    
612  DSPEC is a symbol or a \"definition specifier\" describing the  DSPEC is a \"definition specifier\" describing the
613  definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or  definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
614  \(DEFVAR BAR).")  \(DEFVAR FOO).
615    
616    LOCATION is the source location for the definition.")
617    
618    (definterface buffer-first-change (filename)
619      "Called for effect the first time FILENAME's buffer is modified."
620      (declare (ignore filename))
621      nil)
622    
623    
624  ;;;; XREF  ;;;; XREF
# Line 361  definition, e.g., FOO or (METHOD FOO (ST Line 627  definition, e.g., FOO or (METHOD FOO (ST
627    "Return the call sites of FUNCTION-NAME (a symbol).    "Return the call sites of FUNCTION-NAME (a symbol).
628  The results is a list ((DSPEC LOCATION) ...).")  The results is a list ((DSPEC LOCATION) ...).")
629    
630    (definterface calls-who (function-name)
631      "Return the call sites of FUNCTION-NAME (a symbol).
632    The results is a list ((DSPEC LOCATION) ...).")
633    
634  (definterface who-references (variable-name)  (definterface who-references (variable-name)
635    "Return the locations where VARIABLE-NAME (a symbol) is referenced.    "Return the locations where VARIABLE-NAME (a symbol) is referenced.
636  See WHO-CALLS for a description of the return value.")  See WHO-CALLS for a description of the return value.")
# Line 436  themselves, that is, their dispatch func Line 706  themselves, that is, their dispatch func
706    
707  ;;;; Inspector  ;;;; Inspector
708    
709  (definterface inspected-parts (object)  (defclass inspector ()
710    "Return a short description and a list of (LABEL . VALUE) pairs."    ()
711    (values (format nil "~S is an atom." object) '()))    (:documentation "Super class of inspector objects.
712    
713    Implementations should sub class in order to dispatch off of the
714    inspect-for-emacs method."))
715    
716    (definterface make-default-inspector ()
717      "Return an inspector object suitable for passing to inspect-for-emacs.")
718    
719    (definterface inspect-for-emacs (object inspector)
720       "Explain to Emacs how to inspect OBJECT.
721    
722    The argument INSPECTOR is an object representing how to get at
723    the internals of OBJECT, it is usually an implementation specific
724    class used simply for dispatching to the proper method.
725    
726    The orgument INSPECTION-MODE is an object specifying how, and
727    what, to show to the user.
728    
729    Returns two values: a string which will be used as the title of
730    the inspector buffer and a list specifying how to render the
731    object for inspection.
732    
733    Every element of the list must be either a string, which will be
734    inserted into the buffer as is, or a list of the form:
735    
736     (:value object &optional format) - Render an inspectable
737     object. If format is provided it must be a string and will be
738     rendered in place of the value, otherwise use princ-to-string.
739    
740     (:newline) - Render a \\n
741    
742     (:action label lambda) - Render LABEL (a text string) which when
743     clicked will call LAMBDA.
744    
745     NIL - do nothing.")
746    
747    (defmethod inspect-for-emacs ((object t) (inspector t))
748      "Generic method for inspecting any kind of object.
749    
750    Since we don't know how to deal with OBJECT we simply dump the
751    output of CL:DESCRIBE."
752      (declare (ignore inspector))
753      (values
754       "A value."
755       `("Type: " (:value ,(type-of object)) (:newline)
756         "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
757         (:newline) (:newline)
758         ,(with-output-to-string (desc) (describe object desc)))))
759    
760    ;;; Utilities for inspector methods.
761    ;;;
762    (defun label-value-line (label value)
763      "Create a control list which prints \"LABEL: VALUE\" in the inspector."
764      (list (princ-to-string label) ": " `(:value ,value) '(:newline)))
765    
766    (defmacro label-value-line* (&rest label-values)
767      ` (append ,@(loop for (label value) in label-values
768                        collect `(label-value-line ,label ,value))))
769    
770  (definterface describe-primitive-type (object)  (definterface describe-primitive-type (object)
771    "Return a string describing the primitive type of object."    "Return a string describing the primitive type of object."
# Line 451  themselves, that is, their dispatch func Line 778  themselves, that is, their dispatch func
778  ;;; The default implementations are sufficient for non-multiprocessing  ;;; The default implementations are sufficient for non-multiprocessing
779  ;;; implementations.  ;;; implementations.
780    
781  (definterface startup-multiprocessing ()  (definterface initialize-multiprocessing ()
782     "Initialize multiprocessing, if necessary.     "Initialize multiprocessing, if necessary."
783       nil)
784    
785  This function is called directly through the listener, not in an RPC  (definterface startup-idle-and-top-level-loops ()
786      "This function is called directly through the listener, not in an RPC
787  from Emacs. This is to support interfaces such as CMUCL's  from Emacs. This is to support interfaces such as CMUCL's
788  MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a  MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
789  normal function."  normal function."
# Line 463  normal function." Line 792  normal function."
792  (definterface spawn (fn &key name)  (definterface spawn (fn &key name)
793    "Create a new thread to call FN.")    "Create a new thread to call FN.")
794    
795    (definterface thread-id (thread)
796      "Return an Emacs-parsable object to identify THREAD.
797    
798    Ids should be comparable with equal, i.e.:
799     (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")
800    
801    (definterface find-thread (id)
802      "Return the thread for ID.
803    ID should be an id previously obtained with THREAD-ID.
804    Can return nil if the thread no longer exists.")
805    
806  (definterface thread-name (thread)  (definterface thread-name (thread)
807     "Return the name of THREAD.     "Return the name of THREAD.
808    
# Line 512  Only one thread may hold the lock (via C Line 852  Only one thread may hold the lock (via C
852    
853  (definterface receive ()  (definterface receive ()
854    "Return the next message from current thread's mailbox.")    "Return the next message from current thread's mailbox.")
855    
856    (definterface toggle-trace (spec)
857      "Toggle tracing of the function(s) given with SPEC.
858    SPEC can be:
859     (setf NAME)                            ; a setf function
860     (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
861     (:defgeneric NAME)                     ; a generic function with all methods
862     (:call CALLER CALLEE)                  ; trace calls from CALLER to CALLEE.
863     (:labels TOPLEVEL LOCAL)
864     (:flet TOPLEVEL LOCAL) ")
865    
866    
867    ;;;; Weak datastructures
868    
869    (definterface make-weak-key-hash-table (&rest args)
870      "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
871      (apply #'make-hash-table args))
872    
873    (definterface make-weak-value-hash-table (&rest args)
874      "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
875      (apply #'make-hash-table args))

Legend:
Removed from v.1.36  
changed lines
  Added in v.1.94

  ViewVC Help
Powered by ViewVC 1.1.5