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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.74 - (show annotations)
Mon Nov 15 22:45:23 2004 UTC (9 years, 5 months ago) by heller
Branch: MAIN
CVS Tags: MULTIBYTE-ENCODING
Changes since 1.73: +2 -6 lines
(emacs-connected): Don't pass the stream as argument.
make-stream-interactive is a better place for setting buffering
options.
1 ;;;; -*- Mode: lisp; indent-tabs-mode: nil; outline-regexp: ";;;;;*" -*-
2 ;;;
3 ;;; slime-backend.lisp --- SLIME backend interface.
4 ;;;
5 ;;; Created by James Bielman in 2003. Released into the public domain.
6 ;;;
7 ;;; This file defines the functions that must be implemented
8 ;;; separately for each Lisp. Each is declared as a generic function
9 ;;; for which swank-<implementation>.lisp provides methods.
10
11 (defpackage :swank-backend
12 (:use :common-lisp)
13 (:export #:sldb-condition
14 #:original-condition
15 #:compiler-condition
16 #:message
17 #:short-message
18 #:condition
19 #:severity
20 #:location
21 #:location-p
22 #:location-buffer
23 #:location-position
24 #:position-p
25 #:position-pos
26 #:print-output-to-string
27 #:quit-lisp
28 #:references
29 #:unbound-slot-filler
30 ;; inspector related symbols
31 #:inspector
32 #:inspect-for-emacs
33 #:raw-inspection
34 #:fancy-inspection
35 #:label-value-line
36 #:label-value-line*
37 ))
38
39 (defpackage :swank-mop
40 (:use)
41 (:export
42 ;; classes
43 #:standard-generic-function
44 #:standard-slot-definition
45 #:standard-method
46 #:standard-class
47 #:eql-specializer
48 #:eql-specializer-object
49 ;; standard-class readers
50 #:class-default-initargs
51 #:class-direct-default-initargs
52 #:class-direct-slots
53 #:class-direct-subclasses
54 #:class-direct-superclasses
55 #:class-finalized-p
56 #:class-name
57 #:class-precedence-list
58 #:class-prototype
59 #:class-slots
60 #:specializer-direct-methods
61 ;; generic function readers
62 #:generic-function-argument-precedence-order
63 #:generic-function-declarations
64 #:generic-function-lambda-list
65 #:generic-function-methods
66 #:generic-function-method-class
67 #:generic-function-method-combination
68 #:generic-function-name
69 ;; method readers
70 #:method-generic-function
71 #:method-function
72 #:method-lambda-list
73 #:method-specializers
74 #:method-qualifiers
75 ;; slot readers
76 #:slot-definition-allocation
77 #:slot-definition-documentation
78 #:slot-definition-initargs
79 #:slot-definition-initform
80 #:slot-definition-initfunction
81 #:slot-definition-name
82 #:slot-definition-type
83 #:slot-definition-readers
84 #:slot-definition-writers))
85
86 (in-package :swank-backend)
87
88
89 ;;;; Metacode
90
91 (defparameter *interface-functions* '()
92 "The names of all interface functions.")
93
94 (defparameter *unimplemented-interfaces* '()
95 "List of interface functions that are not implemented.
96 DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
97
98 (defmacro definterface (name args documentation &rest default-body)
99 "Define an interface function for the backend to implement.
100 A generic function is defined with NAME, ARGS, and DOCUMENTATION.
101
102 If a DEFAULT-BODY is supplied then NO-APPLICABLE-METHOD is specialized
103 to execute the body if the backend doesn't provide a specific
104 implementation.
105
106 Backends implement these functions using DEFIMPLEMENTATION."
107 (check-type documentation string "a documentation string")
108 (flet ((gen-default-impl ()
109 `(defmethod ,name ,args ,@default-body)))
110 `(progn (defgeneric ,name ,args (:documentation ,documentation))
111 (pushnew ',name *interface-functions*)
112 ,(if (null default-body)
113 `(pushnew ',name *unimplemented-interfaces*)
114 (gen-default-impl))
115 ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
116 (eval-when (:compile-toplevel :load-toplevel :execute)
117 (export ',name :swank-backend))
118 ',name)))
119
120 (defmacro defimplementation (name args &body body)
121 `(progn (defmethod ,name ,args ,@body)
122 (if (member ',name *interface-functions*)
123 (setq *unimplemented-interfaces*
124 (remove ',name *unimplemented-interfaces*))
125 (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
126 ',name))
127
128 (defun warn-unimplemented-interfaces ()
129 "Warn the user about unimplemented backend features.
130 The portable code calls this function at startup."
131 (warn "These Swank interfaces are unimplemented:~% ~A"
132 (sort (copy-list *unimplemented-interfaces*) #'string<)))
133
134 (defun import-to-swank-mop (symbol-list)
135 (dolist (sym symbol-list)
136 (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
137 (when swank-mop-sym
138 (unintern swank-mop-sym :swank-mop))
139 (import sym :swank-mop)
140 (export sym :swank-mop))))
141
142 (defun import-swank-mop-symbols (package except)
143 "Import the mop symbols from PACKAGE to SWANK-MOP.
144 EXCEPT is a list of symbol names which should be ignored."
145 (do-symbols (s :swank-mop)
146 (unless (member s except :test #'string=)
147 (let ((real-symbol (find-symbol (string s) package)))
148 (assert real-symbol)
149 (unintern s :swank-mop)
150 (import real-symbol :swank-mop)
151 (export real-symbol :swank-mop)))))
152
153
154 ;;;; Utilities
155
156 (defmacro with-struct ((conc-name &rest names) obj &body body)
157 "Like with-slots but works only for structs."
158 (flet ((reader (slot) (intern (concatenate 'string
159 (symbol-name conc-name)
160 (symbol-name slot))
161 (symbol-package conc-name))))
162 (let ((tmp (gensym "OO-")))
163 ` (let ((,tmp ,obj))
164 (symbol-macrolet
165 ,(loop for name in names collect
166 (typecase name
167 (symbol `(,name (,(reader name) ,tmp)))
168 (cons `(,(first name) (,(reader (second name)) ,tmp)))
169 (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
170 ,@body)))))
171
172
173 ;;;; TCP server
174
175 (definterface create-socket (host port)
176 "Create a listening TCP socket on interface HOST and port PORT .")
177
178 (definterface local-port (socket)
179 "Return the local port number of SOCKET.")
180
181 (definterface close-socket (socket)
182 "Close the socket SOCKET.")
183
184 (definterface accept-connection (socket)
185 "Accept a client connection on the listening socket SOCKET. Return
186 a stream for the new connection.")
187
188 (definterface add-sigio-handler (socket fn)
189 "Call FN whenever SOCKET is readable.")
190
191 (definterface remove-sigio-handlers (socket)
192 "Remove all sigio handlers for SOCKET.")
193
194 (definterface add-fd-handler (socket fn)
195 "Call FN when Lisp is waiting for input and SOCKET is readable.")
196
197 (definterface remove-fd-handlers (socket)
198 "Remove all fd-handlers for SOCKET.")
199
200 (definterface preferred-communication-style ()
201 "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
202 nil)
203
204 ;;; Base condition for networking errors.
205 (define-condition network-error (simple-error) ())
206
207 (definterface emacs-connected ()
208 "Hook called when the first connection from Emacs is established.
209 Called from the INIT-FN of the socket server that accepts the
210 connection.
211
212 This is intended for setting up extra context, e.g. to discover
213 that the calling thread is the one that interacts with Emacs."
214 nil)
215
216
217 ;;;; Unix signals
218
219 (defconstant +sigint+ 2)
220
221 (definterface call-without-interrupts (fn)
222 "Call FN in a context where interrupts are disabled."
223 (funcall fn))
224
225 (definterface getpid ()
226 "Return the (Unix) process ID of this superior Lisp.")
227
228 (definterface lisp-implementation-type-name ()
229 "Return a short name for the Lisp implementation."
230 (lisp-implementation-type))
231
232 (definterface default-directory ()
233 "Return the default directory."
234 (directory-namestring (truename *default-pathname-defaults*)))
235
236 (definterface set-default-directory (directory)
237 "Set the default directory.
238 This is used to resolve filenames without directory component."
239 (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
240 (default-directory))
241
242 (definterface call-with-syntax-hooks (fn)
243 "Call FN with hooks to handle special syntax."
244 (funcall fn))
245
246 (definterface default-readtable-alist ()
247 "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
248 '())
249
250 (definterface quit-lisp ()
251 "Exit the current lisp image.")
252
253
254 ;;;; Compilation
255
256 (definterface call-with-compilation-hooks (func)
257 "Call FUNC with hooks to record compiler conditions.")
258
259 (defmacro with-compilation-hooks ((&rest ignore) &body body)
260 "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
261 (declare (ignore ignore))
262 `(call-with-compilation-hooks (lambda () (progn ,@body))))
263
264 (definterface swank-compile-string (string &key buffer position directory)
265 "Compile source from STRING. During compilation, compiler
266 conditions must be trapped and resignalled as COMPILER-CONDITIONs.
267
268 If supplied, BUFFER and POSITION specify the source location in Emacs.
269
270 Additionally, if POSITION is supplied, it must be added to source
271 positions reported in compiler conditions.
272
273 If DIRECTORY is specified it may be used by certain implementations to
274 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
275 source information.")
276
277 (definterface operate-on-system (system-name operation-name &rest keyword-args)
278 "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.
279 The KEYWORD-ARGS are passed on to the operation.
280 Example:
281 \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"
282 (unless (member :asdf *features*)
283 (error "ASDF is not loaded."))
284 (with-compilation-hooks ()
285 (let ((operate (find-symbol "OPERATE" :asdf))
286 (operation (find-symbol operation-name :asdf)))
287 (when (null operation)
288 (error "Couldn't find ASDF operation ~S" operation-name))
289 (apply operate operation system-name keyword-args))))
290
291 (definterface swank-compile-file (filename load-p)
292 "Compile FILENAME signalling COMPILE-CONDITIONs.
293 If LOAD-P is true, load the file after compilation.")
294
295 (deftype severity ()
296 '(member :error :read-error :warning :style-warning :note))
297
298 ;; Base condition type for compiler errors, warnings and notes.
299 (define-condition compiler-condition (condition)
300 ((original-condition
301 ;; The original condition thrown by the compiler if appropriate.
302 ;; May be NIL if a compiler does not report using conditions.
303 :type (or null condition)
304 :initarg :original-condition
305 :accessor original-condition)
306
307 (severity :type severity
308 :initarg :severity
309 :accessor severity)
310
311 (message :initarg :message
312 :accessor message)
313
314 (short-message :initarg :short-message
315 :initform nil
316 :accessor short-message)
317
318 (references :initarg :references
319 :initform nil
320 :accessor references)
321
322 (location :initarg :location
323 :accessor location)))
324
325
326 ;;;; Streams
327
328 (definterface make-fn-streams (input-fn output-fn)
329 "Return character input and output streams backended by functions.
330 When input is needed, INPUT-FN is called with no arguments to
331 return a string.
332 When output is ready, OUTPUT-FN is called with the output as its
333 argument.
334
335 Output should be forced to OUTPUT-FN before calling INPUT-FN.
336
337 The streams are returned as two values.")
338
339 (definterface make-stream-interactive (stream)
340 "Do any necessary setup to make STREAM work interactively.
341 This is called for each stream used for interaction with the user
342 \(e.g. *standard-output*). An implementation could setup some
343 implementation-specific functions to control output flushing at the
344 like."
345 (declare (ignore stream))
346 nil)
347
348
349 ;;;; Documentation
350
351 (definterface arglist (name)
352 "Return the lambda list for the symbol NAME. NAME can also be
353 a lisp function object, on lisps which support this.
354
355 The result can be a list or the :not-available if the arglist
356 cannot be determined."
357 (declare (ignore name))
358 :not-available)
359
360 (definterface function-name (function)
361 "Return the name of the function object FUNCTION.
362
363 The result is either a symbol, a list, or NIL if no function name is available."
364 (declare (ignore function))
365 nil)
366
367 (definterface macroexpand-all (form)
368 "Recursively expand all macros in FORM.
369 Return the resulting form.")
370
371 (definterface describe-symbol-for-emacs (symbol)
372 "Return a property list describing SYMBOL.
373
374 The property list has an entry for each interesting aspect of the
375 symbol. The recognised keys are:
376
377 :VARIABLE :FUNCTION :SETF :TYPE :CLASS :MACRO :COMPILER-MACRO
378 :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
379
380 The value of each property is the corresponding documentation string,
381 or :NOT-DOCUMENTED. It is legal to include keys not listed here.
382
383 Properties should be included if and only if they are applicable to
384 the symbol. For example, only (and all) fbound symbols should include
385 the :FUNCTION property.
386
387 Example:
388 \(describe-symbol-for-emacs 'vector)
389 => (:CLASS :NOT-DOCUMENTED
390 :TYPE :NOT-DOCUMENTED
391 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
392
393 (definterface describe-definition (name type)
394 "Describe the definition NAME of TYPE.
395 TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
396
397 Return a documentation string, or NIL if none is available.")
398
399
400 ;;;; Debugging
401
402 (definterface call-with-debugging-environment (debugger-loop-fn)
403 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
404
405 This function is called recursively at each debug level to invoke the
406 debugger loop. The purpose is to setup any necessary environment for
407 other debugger callbacks that will be called within the debugger loop.
408
409 For example, this is a reasonable place to compute a backtrace, switch
410 to safe reader/printer settings, and so on.")
411
412 (define-condition sldb-condition (condition)
413 ((original-condition
414 :initarg :original-condition
415 :accessor original-condition))
416 (:report (lambda (condition stream)
417 (format stream "Condition in debugger code~@[: ~A~]"
418 (original-condition condition))))
419 (:documentation
420 "Wrapper for conditions that should not be debugged.
421
422 When a condition arises from the internals of the debugger, it is not
423 desirable to debug it -- we'd risk entering an endless loop trying to
424 debug the debugger! Instead, such conditions can be reported to the
425 user without (re)entering the debugger by wrapping them as
426 `sldb-condition's."))
427
428 (definterface compute-backtrace (start end)
429 "Return a list containing a backtrace of the condition current
430 being debugged. The results are unspecified if this function is
431 called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.
432
433 START and END are zero-based indices constraining the number of frames
434 returned. Frame zero is defined as the frame which invoked the
435 debugger. If END is nil, return the frames from START to the end of
436 the stack.")
437
438 (definterface print-frame (frame stream)
439 "Print frame to stream.")
440
441 (definterface frame-package (frame)
442 "Return the preferred package to use when printing local variables.
443 NIL can be used if no particular package is known."
444 (declare (ignore frame))
445 nil)
446
447 (definterface frame-source-location-for-emacs (frame-number)
448 "Return the source location for FRAME-NUMBER.")
449
450 (definterface frame-catch-tags (frame-number)
451 "Return a list of XXX list of what? catch tags for a debugger
452 stack frame. The results are undefined unless this is called
453 within the dynamic contour of a function defined by
454 DEFINE-DEBUGGER-HOOK.")
455
456 (definterface frame-locals (frame-number)
457 "Return a list of XXX local variable designators define me
458 for a debugger stack frame. The results are undefined unless
459 this is called within the dynamic contour of a function defined
460 by DEFINE-DEBUGGER-HOOK.")
461
462 (definterface frame-var-value (frame var)
463 "Return the value of VAR in FRAME.
464 FRAME is the number of the frame in the backtrace.
465 VAR is the number of the variable in the frame.")
466
467 (definterface disassemble-frame (frame-number)
468 "Disassemble the code for the FRAME-NUMBER.
469 The output should be written to standard output.
470 FRAME-NUMBER is a non-negative interger.")
471
472 (definterface eval-in-frame (form frame-number)
473 "Evaluate a Lisp form in the lexical context of a stack frame
474 in the debugger. The results are undefined unless called in the
475 dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.
476
477 FRAME-NUMBER must be a positive integer with 0 indicating the
478 frame which invoked the debugger.
479
480 The return value is the result of evaulating FORM in the
481 appropriate context.")
482
483 (definterface return-from-frame (frame-number form)
484 "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
485 produced by evaluating FORM in the frame context to its caller.
486
487 Execute any clean-up code from unwind-protect forms above the frame
488 during unwinding.
489
490 Return a string describing the error if it's not possible to return
491 from the frame.")
492
493 (definterface restart-frame (frame-number)
494 "Restart execution of the frame FRAME-NUMBER with the same arguments
495 as it was called originally.")
496
497 (definterface format-sldb-condition (condition)
498 "Format a condition for display in SLDB."
499 (princ-to-string condition))
500
501 (definterface condition-references (condition)
502 "Return a list of documentation references for a condition.
503 Each reference is one of:
504 (:ANSI-CL
505 {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY }
506 symbol-or-name)
507 (:SBCL :NODE node-name)"
508 (declare (ignore condition))
509 '())
510
511 (definterface condition-extras (condition)
512 "Return a list of extra for the debugger.
513 The allowed elements are of the form:
514 (:SHOW-FRAME-SOURCE frame-number)"
515 (declare (ignore condition))
516 '())
517
518 (definterface activate-stepping (frame-number)
519 "Prepare the frame FRAME-NUMBER for stepping.")
520
521 (definterface sldb-break-on-return (frame-number)
522 "Set a breakpoint in the frame FRAME-NUMBER.")
523
524 (definterface sldb-break-at-start (symbol)
525 "Set a breakpoint on the beginning of the function for SYMBOL.")
526
527
528
529 ;;;; Definition finding
530
531 (defstruct (:location (:type list) :named
532 (:constructor make-location
533 (buffer position &optional hints)))
534 buffer position
535 ;; Hints is a property list optionally containing:
536 ;; :snippet SOURCE-TEXT
537 ;; This is a snippet of the actual source text at the start of
538 ;; the definition, which could be used in a text search.
539 hints)
540
541 (defstruct (:error (:type list) :named (:constructor)) message)
542 (defstruct (:file (:type list) :named (:constructor)) name)
543 (defstruct (:buffer (:type list) :named (:constructor)) name)
544 (defstruct (:position (:type list) :named (:constructor)) pos)
545
546 (definterface find-definitions (name)
547 "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
548
549 NAME is a \"definition specifier\".
550
551 DSPEC is a \"definition specifier\" describing the
552 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
553 \(DEFVAR FOO).
554
555 LOCATION is the source location for the definition.")
556
557 (definterface buffer-first-change (filename)
558 "Called for effect the first time FILENAME's buffer is modified."
559 (declare (ignore filename))
560 nil)
561
562
563 ;;;; XREF
564
565 (definterface who-calls (function-name)
566 "Return the call sites of FUNCTION-NAME (a symbol).
567 The results is a list ((DSPEC LOCATION) ...).")
568
569 (definterface who-references (variable-name)
570 "Return the locations where VARIABLE-NAME (a symbol) is referenced.
571 See WHO-CALLS for a description of the return value.")
572
573 (definterface who-binds (variable-name)
574 "Return the locations where VARIABLE-NAME (a symbol) is bound.
575 See WHO-CALLS for a description of the return value.")
576
577 (definterface who-sets (variable-name)
578 "Return the locations where VARIABLE-NAME (a symbol) is set.
579 See WHO-CALLS for a description of the return value.")
580
581 (definterface who-macroexpands (macro-name)
582 "Return the locations where MACRO-NAME (a symbol) is expanded.
583 See WHO-CALLS for a description of the return value.")
584
585 (definterface who-specializes (class-name)
586 "Return the locations where CLASS-NAME (a symbol) is specialized.
587 See WHO-CALLS for a description of the return value.")
588
589 ;;; Simpler variants.
590
591 (definterface list-callers (function-name)
592 "List the callers of FUNCTION-NAME.
593 This function is like WHO-CALLS except that it is expected to use
594 lower-level means. Whereas WHO-CALLS is usually implemented with
595 special compiler support, LIST-CALLERS is usually implemented by
596 groveling for constants in function objects throughout the heap.
597
598 The return value is as for WHO-CALLS.")
599
600 (definterface list-callees (function-name)
601 "List the functions called by FUNCTION-NAME.
602 See LIST-CALLERS for a description of the return value.")
603
604
605 ;;;; Profiling
606
607 ;;; The following functions define a minimal profiling interface.
608
609 (definterface profile (fname)
610 "Marks symbol FNAME for profiling.")
611
612 (definterface profiled-functions ()
613 "Returns a list of profiled functions.")
614
615 (definterface unprofile (fname)
616 "Marks symbol FNAME as not profiled.")
617
618 (definterface unprofile-all ()
619 "Marks all currently profiled functions as not profiled."
620 (dolist (f (profiled-functions))
621 (unprofile f)))
622
623 (definterface profile-report ()
624 "Prints profile report.")
625
626 (definterface profile-reset ()
627 "Resets profile counters.")
628
629 (definterface profile-package (package callers-p methods)
630 "Wrap profiling code around all functions in PACKAGE. If a function
631 is already profiled, then unprofile and reprofile (useful to notice
632 function redefinition.)
633
634 If CALLERS-P is T names have counts of the most common calling
635 functions recorded.
636
637 When called with arguments :METHODS T, profile all methods of all
638 generic functions having names in the given package. Generic functions
639 themselves, that is, their dispatch functions, are left alone.")
640
641
642 ;;;; Inspector
643
644 (defclass inspector ()
645 ()
646 (:documentation "Super class of inspector objects.
647
648 Implementations should sub class in order to dispatch off of the
649 inspect-for-emacs method."))
650
651 (definterface make-default-inspector ()
652 "Return an inspector object suitable for passing to inspect-for-emacs.")
653
654 (definterface inspect-for-emacs (object inspector)
655 "Explain to emacs how to inspect OBJECT.
656
657 The argument INSPECTOR is an object representing how to get at
658 the internals of OBJECT, it is usually an implementation specific
659 class used simply for dispatching to the proper method.
660
661 The orgument INSPECTION-MODE is an object specifying how, and
662 what, to show to the user.
663
664 Returns two values: a string which will be used as the title of
665 the inspector buffer and a list specifying how to render the
666 object for inspection.
667
668 Every elementi of the list must be either a string, which will be
669 inserted into the buffer as is, or a list of the form:
670
671 (:value object &optional format) - Render an inspectable
672 object. If format is provided it must be a string and will be
673 rendered in place of the value, otherwise use princ-to-string.
674
675 (:newline) - Render a \\n
676
677 (:action label lambda) - Render LABEL (a text string) which when
678 clicked will call LAMBDA.
679
680 NIL - do nothing.")
681
682 (defmethod inspect-for-emacs ((object t) (inspector t))
683 "Generic method for inspecting any kind of object.
684
685 Since we don't know how to deal with OBJECT we simply dump the
686 output of CL:DESCRIBE."
687 (declare (ignore inspector))
688 (values "A value."
689 `("Type: " (:value ,(type-of object))
690 (:newline)
691 "Don't know how to inspect the object, dumping output of CL:DESCIRBE:"
692 (:newline) (:newline)
693 ,(with-output-to-string (desc)
694 (describe object desc)))))
695
696 ;;; Utilities to for inspector methods.
697 ;;;
698 (defun label-value-line (label value)
699 "Create a control list which prints \"LABEL: VALUE\" in the inspector."
700 (list (princ-to-string label) ": " `(:value ,value) '(:newline)))
701
702 (defmacro label-value-line* (&rest label-values)
703 ` (append ,@(loop for (label value) in label-values
704 collect `(label-value-line ,label ,value))))
705
706 (definterface describe-primitive-type (object)
707 "Return a string describing the primitive type of object."
708 (declare (ignore object))
709 "N/A")
710
711
712 ;;;; Multithreading
713 ;;;
714 ;;; The default implementations are sufficient for non-multiprocessing
715 ;;; implementations.
716
717 (definterface startup-multiprocessing ()
718 "Initialize multiprocessing, if necessary.
719
720 This function is called directly through the listener, not in an RPC
721 from Emacs. This is to support interfaces such as CMUCL's
722 MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a
723 normal function."
724 nil)
725
726 (definterface spawn (fn &key name)
727 "Create a new thread to call FN.")
728
729 (definterface thread-id (thread)
730 "Return an Emacs-parsable object to identify THREAD.
731
732 Ids should be comparable with equal, i.e.:
733 (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")
734
735 (definterface find-thread (id)
736 "Return the thread for ID.
737 ID should be an id previously obtained with THREAD-ID.
738 Can return nil if the thread no longer exists.")
739
740 (definterface thread-name (thread)
741 "Return the name of THREAD.
742
743 Thread names are be single-line strings and are meaningful to the
744 user. They do not have to be unique."
745 (declare (ignore thread))
746 "The One True Thread")
747
748 (definterface thread-status (thread)
749 "Return a string describing THREAD's state."
750 (declare (ignore thread))
751 "")
752
753 (definterface make-lock (&key name)
754 "Make a lock for thread synchronization.
755 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."
756 (declare (ignore name))
757 :null-lock)
758
759 (definterface call-with-lock-held (lock function)
760 "Call FUNCTION with LOCK held, queueing if necessary."
761 (declare (ignore lock)
762 (type function function))
763 (funcall function))
764
765 (definterface current-thread ()
766 "Return the currently executing thread."
767 0)
768
769 (definterface all-threads ()
770 "Return a list of all threads.")
771
772 (definterface thread-alive-p (thread)
773 "Test if THREAD is termintated."
774 (member thread (all-threads)))
775
776 (definterface interrupt-thread (thread fn)
777 "Cause THREAD to execute FN.")
778
779 (definterface kill-thread (thread)
780 "Kill THREAD."
781 (declare (ignore thread))
782 nil)
783
784 (definterface send (thread object)
785 "Send OBJECT to thread THREAD.")
786
787 (definterface receive ()
788 "Return the next message from current thread's mailbox.")

  ViewVC Help
Powered by ViewVC 1.1.5