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

Contents of /slime/swank-backend.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.210 - (show annotations)
Sun Nov 6 17:06:09 2011 UTC (2 years, 5 months ago) by heller
Branch: MAIN
Changes since 1.209: +10 -9 lines
New wire format.

Switch from character streams to binary streams.  Counting
characters was error prone because some Lisps use utf-16
internally and so READ-SEQUENCE can't be used easily.

The new format looks so:

  | byte0 | 3 bytes length |
  |    ... payload ...     |

The playload is an s-exp encoded as UTF-8 string.  byte0 is
currently always 0; other values are reserved for future use.

* swank-rpc.lisp (write-message): Use new format.
(write-header, parse-header, asciify, encoding-error): New.

* swank.lisp (accept-connections): Create a binary stream.
(input-available-p): Can't read-char-no-hang on binary streams.

* slime.el (slime-net-connect): Use binary as coding system.
(slime-net-send, slime-net-read, slime-net-decode-length)
(slime-net-encode-length, slime-net-have-input-p): Use new format.
(slime-unibyte-string, slime-handle-net-read-error): New.
(featurep): Require 'un-define for XEmacs.
([test] break): Longer timeouts.

* swank-sbcl.lisp (input-ready-p): Use sb-sys:wait-until-fd-usable.
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 ;;;; Frontmatter
8 ;;;
9 ;;; 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
13 (defpackage :swank-backend
14 (:use :common-lisp)
15 (:export #:*debug-swank-backend*
16 #:sldb-condition
17 #:compiler-condition
18 #:original-condition
19 #:message
20 #:source-context
21 #:condition
22 #:severity
23 #:with-compilation-hooks
24 #:location
25 #:location-p
26 #:location-buffer
27 #:location-position
28 #:position-p
29 #:position-pos
30 #:print-output-to-string
31 #:quit-lisp
32 #:references
33 #:unbound-slot-filler
34 #:declaration-arglist
35 #:type-specifier-arglist
36 #:with-struct
37 #:when-let
38 ;; interrupt macro for the backend
39 #:*pending-slime-interrupts*
40 #:check-slime-interrupts
41 #:*interrupt-queued-handler*
42 ;; inspector related symbols
43 #:emacs-inspect
44 #:label-value-line
45 #:label-value-line*
46 #:with-symbol))
47
48 (defpackage :swank-mop
49 (:use)
50 (:export
51 ;; classes
52 #:standard-generic-function
53 #:standard-slot-definition
54 #:standard-method
55 #:standard-class
56 #:eql-specializer
57 #:eql-specializer-object
58 ;; standard-class readers
59 #:class-default-initargs
60 #:class-direct-default-initargs
61 #:class-direct-slots
62 #:class-direct-subclasses
63 #:class-direct-superclasses
64 #:class-finalized-p
65 #:class-name
66 #:class-precedence-list
67 #:class-prototype
68 #:class-slots
69 #:specializer-direct-methods
70 ;; generic function readers
71 #:generic-function-argument-precedence-order
72 #:generic-function-declarations
73 #:generic-function-lambda-list
74 #:generic-function-methods
75 #:generic-function-method-class
76 #:generic-function-method-combination
77 #:generic-function-name
78 ;; method readers
79 #:method-generic-function
80 #:method-function
81 #:method-lambda-list
82 #:method-specializers
83 #:method-qualifiers
84 ;; slot readers
85 #:slot-definition-allocation
86 #:slot-definition-documentation
87 #:slot-definition-initargs
88 #:slot-definition-initform
89 #:slot-definition-initfunction
90 #:slot-definition-name
91 #:slot-definition-type
92 #:slot-definition-readers
93 #:slot-definition-writers
94 #:slot-boundp-using-class
95 #:slot-value-using-class
96 #:slot-makunbound-using-class
97 ;; generic function protocol
98 #:compute-applicable-methods-using-classes
99 #:finalize-inheritance))
100
101 (in-package :swank-backend)
102
103
104 ;;;; Metacode
105
106 (defparameter *debug-swank-backend* nil
107 "If this is true, backends should not catch errors but enter the
108 debugger where appropriate. Also, they should not perform backtrace
109 magic but really show every frame including SWANK related ones.")
110
111 (defparameter *interface-functions* '()
112 "The names of all interface functions.")
113
114 (defparameter *unimplemented-interfaces* '()
115 "List of interface functions that are not implemented.
116 DEFINTERFACE adds to this list and DEFIMPLEMENTATION removes.")
117
118 (defmacro definterface (name args documentation &rest default-body)
119 "Define an interface function for the backend to implement.
120 A function is defined with NAME, ARGS, and DOCUMENTATION. This
121 function first looks for a function to call in NAME's property list
122 that is indicated by 'IMPLEMENTATION; failing that, it looks for a
123 function indicated by 'DEFAULT. If neither is present, an error is
124 signaled.
125
126 If a DEFAULT-BODY is supplied, then a function with the same body and
127 ARGS will be added to NAME's property list as the property indicated
128 by 'DEFAULT.
129
130 Backends implement these functions using DEFIMPLEMENTATION."
131 (check-type documentation string "a documentation string")
132 (assert (every #'symbolp args) ()
133 "Complex lambda-list not supported: ~S ~S" name args)
134 (labels ((gen-default-impl ()
135 `(setf (get ',name 'default) (lambda ,args ,@default-body)))
136 (args-as-list (args)
137 (destructuring-bind (req opt key rest) (parse-lambda-list args)
138 `(,@req ,@opt
139 ,@(loop for k in key append `(,(kw k) ,k))
140 ,@(or rest '(())))))
141 (parse-lambda-list (args)
142 (parse args '(&optional &key &rest)
143 (make-array 4 :initial-element nil)))
144 (parse (args keywords vars)
145 (cond ((null args)
146 (reverse (map 'list #'reverse vars)))
147 ((member (car args) keywords)
148 (parse (cdr args) (cdr (member (car args) keywords)) vars))
149 (t (push (car args) (aref vars (length keywords)))
150 (parse (cdr args) keywords vars))))
151 (kw (s) (intern (string s) :keyword)))
152 `(progn
153 (defun ,name ,args
154 ,documentation
155 (let ((f (or (get ',name 'implementation)
156 (get ',name 'default))))
157 (cond (f (apply f ,@(args-as-list args)))
158 (t (error "~S not implemented" ',name)))))
159 (pushnew ',name *interface-functions*)
160 ,(if (null default-body)
161 `(pushnew ',name *unimplemented-interfaces*)
162 (gen-default-impl))
163 ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
164 (eval-when (:compile-toplevel :load-toplevel :execute)
165 (export ',name :swank-backend))
166 ',name)))
167
168 (defmacro defimplementation (name args &body body)
169 (assert (every #'symbolp args) ()
170 "Complex lambda-list not supported: ~S ~S" name args)
171 `(progn
172 (setf (get ',name 'implementation)
173 ;; For implicit BLOCK. FLET because of interplay w/ decls.
174 (flet ((,name ,args ,@body)) #',name))
175 (if (member ',name *interface-functions*)
176 (setq *unimplemented-interfaces*
177 (remove ',name *unimplemented-interfaces*))
178 (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
179 ',name))
180
181 (defun warn-unimplemented-interfaces ()
182 "Warn the user about unimplemented backend features.
183 The portable code calls this function at startup."
184 (let ((*print-pretty* t))
185 (warn "These Swank interfaces are unimplemented:~% ~:<~{~A~^ ~:_~}~:>"
186 (list (sort (copy-list *unimplemented-interfaces*) #'string<)))))
187
188 (defun import-to-swank-mop (symbol-list)
189 (dolist (sym symbol-list)
190 (let* ((swank-mop-sym (find-symbol (symbol-name sym) :swank-mop)))
191 (when swank-mop-sym
192 (unintern swank-mop-sym :swank-mop))
193 (import sym :swank-mop)
194 (export sym :swank-mop))))
195
196 (defun import-swank-mop-symbols (package except)
197 "Import the mop symbols from PACKAGE to SWANK-MOP.
198 EXCEPT is a list of symbol names which should be ignored."
199 (do-symbols (s :swank-mop)
200 (unless (member s except :test #'string=)
201 (let ((real-symbol (find-symbol (string s) package)))
202 (assert real-symbol () "Symbol ~A not found in package ~A" s package)
203 (unintern s :swank-mop)
204 (import real-symbol :swank-mop)
205 (export real-symbol :swank-mop)))))
206
207 (defvar *gray-stream-symbols*
208 '(:fundamental-character-output-stream
209 :stream-write-char
210 :stream-write-string
211 :stream-fresh-line
212 :stream-force-output
213 :stream-finish-output
214 :fundamental-character-input-stream
215 :stream-read-char
216 :stream-peek-char
217 :stream-read-line
218 ;; STREAM-FILE-POSITION is not available on all implementations, or
219 ;; partially under a different name.
220 ; :stream-file-posiion
221 :stream-listen
222 :stream-unread-char
223 :stream-clear-input
224 :stream-line-column
225 :stream-read-char-no-hang
226 ;; STREAM-LINE-LENGTH is an extension to gray streams that's apparently
227 ;; supported by CMUCL, OpenMCL, SBCL and SCL.
228 #+(or cmu openmcl sbcl scl)
229 :stream-line-length))
230
231 (defun import-from (package symbol-names &optional (to-package *package*))
232 "Import the list of SYMBOL-NAMES found in the package PACKAGE."
233 (dolist (name symbol-names)
234 (multiple-value-bind (symbol found) (find-symbol (string name) package)
235 (assert found () "Symbol ~A not found in package ~A" name package)
236 (import symbol to-package))))
237
238
239 ;;;; Utilities
240
241 (defmacro with-struct ((conc-name &rest names) obj &body body)
242 "Like with-slots but works only for structs."
243 (flet ((reader (slot) (intern (concatenate 'string
244 (symbol-name conc-name)
245 (symbol-name slot))
246 (symbol-package conc-name))))
247 (let ((tmp (gensym "OO-")))
248 ` (let ((,tmp ,obj))
249 (symbol-macrolet
250 ,(loop for name in names collect
251 (typecase name
252 (symbol `(,name (,(reader name) ,tmp)))
253 (cons `(,(first name) (,(reader (second name)) ,tmp)))
254 (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
255 ,@body)))))
256
257 (defmacro when-let ((var value) &body body)
258 `(let ((,var ,value))
259 (when ,var ,@body)))
260
261 (defun with-symbol (name package)
262 "Generate a form suitable for testing with #+."
263 (if (and (find-package package)
264 (find-symbol (string name) package))
265 '(:and)
266 '(:or)))
267
268
269 ;;;; UFT8
270
271 (definterface string-to-utf8 (string)
272 "Convert the string STRING to a (simple-array (unsigned-byte 8))")
273
274 (definterface utf8-to-string (octets)
275 "Convert the (simple-array (unsigned-byte 8)) OCTETS to a string.")
276
277
278 ;;;; TCP server
279
280 (definterface create-socket (host port)
281 "Create a listening TCP socket on interface HOST and port PORT .")
282
283 (definterface local-port (socket)
284 "Return the local port number of SOCKET.")
285
286 (definterface close-socket (socket)
287 "Close the socket SOCKET.")
288
289 (definterface accept-connection (socket &key external-format
290 buffering timeout)
291 "Accept a client connection on the listening socket SOCKET.
292 Return a stream for the new connection.
293 If EXTERNAL-FORMAT is nil return a binary stream
294 otherwise create a character stream.
295 BUFFERING can be one of:
296 nil ... no buffering
297 t ... enable buffering
298 :line ... enable buffering with automatic flushing on eol.")
299
300 (definterface add-sigio-handler (socket fn)
301 "Call FN whenever SOCKET is readable.")
302
303 (definterface remove-sigio-handlers (socket)
304 "Remove all sigio handlers for SOCKET.")
305
306 (definterface add-fd-handler (socket fn)
307 "Call FN when Lisp is waiting for input and SOCKET is readable.")
308
309 (definterface remove-fd-handlers (socket)
310 "Remove all fd-handlers for SOCKET.")
311
312 (definterface preferred-communication-style ()
313 "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
314 nil)
315
316 (definterface set-stream-timeout (stream timeout)
317 "Set the 'stream 'timeout. The timeout is either the real number
318 specifying the timeout in seconds or 'nil for no timeout."
319 (declare (ignore stream timeout))
320 nil)
321
322 ;;; Base condition for networking errors.
323 (define-condition network-error (simple-error) ())
324
325 (definterface emacs-connected ()
326 "Hook called when the first connection from Emacs is established.
327 Called from the INIT-FN of the socket server that accepts the
328 connection.
329
330 This is intended for setting up extra context, e.g. to discover
331 that the calling thread is the one that interacts with Emacs."
332 nil)
333
334
335 ;;;; Unix signals
336
337 (defconstant +sigint+ 2)
338
339 (definterface getpid ()
340 "Return the (Unix) process ID of this superior Lisp.")
341
342 (definterface install-sigint-handler (function)
343 "Call FUNCTION on SIGINT (instead of invoking the debugger).
344 Return old signal handler."
345 (declare (ignore function))
346 nil)
347
348 (definterface call-with-user-break-handler (handler function)
349 "Install the break handler HANDLER while executing FUNCTION."
350 (let ((old-handler (install-sigint-handler handler)))
351 (unwind-protect (funcall function)
352 (install-sigint-handler old-handler))))
353
354 (definterface quit-lisp ()
355 "Exit the current lisp image.")
356
357 (definterface lisp-implementation-type-name ()
358 "Return a short name for the Lisp implementation."
359 (lisp-implementation-type))
360
361 (definterface lisp-implementation-program ()
362 "Return the argv[0] of the running Lisp process, or NIL."
363 (let ((file (car (command-line-args))))
364 (when (and file (probe-file file))
365 (namestring (truename file)))))
366
367 (definterface socket-fd (socket-stream)
368 "Return the file descriptor for SOCKET-STREAM.")
369
370 (definterface make-fd-stream (fd external-format)
371 "Create a character stream for the file descriptor FD.")
372
373 (definterface dup (fd)
374 "Duplicate a file descriptor.
375 If the syscall fails, signal a condition.
376 See dup(2).")
377
378 (definterface exec-image (image-file args)
379 "Replace the current process with a new process image.
380 The new image is created by loading the previously dumped
381 core file IMAGE-FILE.
382 ARGS is a list of strings passed as arguments to
383 the new image.
384 This is thin wrapper around exec(3).")
385
386 (definterface command-line-args ()
387 "Return a list of strings as passed by the OS."
388 nil)
389
390
391 ;; pathnames are sooo useless
392
393 (definterface filename-to-pathname (filename)
394 "Return a pathname for FILENAME.
395 A filename in Emacs may for example contain asterisks which should not
396 be translated to wildcards."
397 (parse-namestring filename))
398
399 (definterface pathname-to-filename (pathname)
400 "Return the filename for PATHNAME."
401 (namestring pathname))
402
403 (definterface default-directory ()
404 "Return the default directory."
405 (directory-namestring (truename *default-pathname-defaults*)))
406
407 (definterface set-default-directory (directory)
408 "Set the default directory.
409 This is used to resolve filenames without directory component."
410 (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
411 (default-directory))
412
413
414 (definterface call-with-syntax-hooks (fn)
415 "Call FN with hooks to handle special syntax."
416 (funcall fn))
417
418 (definterface default-readtable-alist ()
419 "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
420 '())
421
422
423 ;;;; Compilation
424
425 (definterface call-with-compilation-hooks (func)
426 "Call FUNC with hooks to record compiler conditions.")
427
428 (defmacro with-compilation-hooks ((&rest ignore) &body body)
429 "Execute BODY as in CALL-WITH-COMPILATION-HOOKS."
430 (declare (ignore ignore))
431 `(call-with-compilation-hooks (lambda () (progn ,@body))))
432
433 (definterface swank-compile-string (string &key buffer position filename
434 policy)
435 "Compile source from STRING.
436 During compilation, compiler conditions must be trapped and
437 resignalled as COMPILER-CONDITIONs.
438
439 If supplied, BUFFER and POSITION specify the source location in Emacs.
440
441 Additionally, if POSITION is supplied, it must be added to source
442 positions reported in compiler conditions.
443
444 If FILENAME is specified it may be used by certain implementations to
445 rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
446 source information.
447
448 If POLICY is supplied, and non-NIL, it may be used by certain
449 implementations to compile with optimization qualities of its
450 value.
451
452 Should return T on successful compilation, NIL otherwise.
453 ")
454
455 (definterface swank-compile-file (input-file output-file load-p
456 external-format
457 &key policy)
458 "Compile INPUT-FILE signalling COMPILE-CONDITIONs.
459 If LOAD-P is true, load the file after compilation.
460 EXTERNAL-FORMAT is a value returned by find-external-format or
461 :default.
462
463 If POLICY is supplied, and non-NIL, it may be used by certain
464 implementations to compile with optimization qualities of its
465 value.
466
467 Should return OUTPUT-TRUENAME, WARNINGS-P and FAILURE-p
468 like `compile-file'")
469
470 (deftype severity ()
471 '(member :error :read-error :warning :style-warning :note :redefinition))
472
473 ;; Base condition type for compiler errors, warnings and notes.
474 (define-condition compiler-condition (condition)
475 ((original-condition
476 ;; The original condition thrown by the compiler if appropriate.
477 ;; May be NIL if a compiler does not report using conditions.
478 :type (or null condition)
479 :initarg :original-condition
480 :accessor original-condition)
481
482 (severity :type severity
483 :initarg :severity
484 :accessor severity)
485
486 (message :initarg :message
487 :accessor message)
488
489 ;; Macro expansion history etc. which may be helpful in some cases
490 ;; but is often very verbose.
491 (source-context :initarg :source-context
492 :type (or null string)
493 :initform nil
494 :accessor source-context)
495
496 (references :initarg :references
497 :initform nil
498 :accessor references)
499
500 (location :initarg :location
501 :accessor location)))
502
503 (definterface find-external-format (coding-system)
504 "Return a \"external file format designator\" for CODING-SYSTEM.
505 CODING-SYSTEM is Emacs-style coding system name (a string),
506 e.g. \"latin-1-unix\"."
507 (if (equal coding-system "iso-latin-1-unix")
508 :default
509 nil))
510
511 (definterface guess-external-format (pathname)
512 "Detect the external format for the file with name pathname.
513 Return nil if the file contains no special markers."
514 ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
515 (with-open-file (s pathname :if-does-not-exist nil
516 :external-format (or (find-external-format "latin-1-unix")
517 :default))
518 (if s
519 (or (let* ((line (read-line s nil))
520 (p (search "-*-" line)))
521 (when p
522 (let* ((start (+ p (length "-*-")))
523 (end (search "-*-" line :start2 start)))
524 (when end
525 (%search-coding line start end)))))
526 (let* ((len (file-length s))
527 (buf (make-string (min len 3000))))
528 (file-position s (- len (length buf)))
529 (read-sequence buf s)
530 (let ((start (search "Local Variables:" buf :from-end t))
531 (end (search "End:" buf :from-end t)))
532 (and start end (< start end)
533 (%search-coding buf start end))))))))
534
535 (defun %search-coding (str start end)
536 (let ((p (search "coding:" str :start2 start :end2 end)))
537 (when p
538 (incf p (length "coding:"))
539 (loop while (and (< p end)
540 (member (aref str p) '(#\space #\tab)))
541 do (incf p))
542 (let ((end (position-if (lambda (c) (find c '(#\space #\tab #\newline)))
543 str :start p)))
544 (find-external-format (subseq str p end))))))
545
546
547 ;;;; Streams
548
549 (definterface make-output-stream (write-string)
550 "Return a new character output stream.
551 The stream calls WRITE-STRING when output is ready.")
552
553 (definterface make-input-stream (read-string)
554 "Return a new character input stream.
555 The stream calls READ-STRING when input is needed.")
556
557
558 ;;;; Documentation
559
560 (definterface arglist (name)
561 "Return the lambda list for the symbol NAME. NAME can also be
562 a lisp function object, on lisps which support this.
563
564 The result can be a list or the :not-available keyword if the
565 arglist cannot be determined."
566 (declare (ignore name))
567 :not-available)
568
569 (defgeneric declaration-arglist (decl-identifier)
570 (:documentation
571 "Return the argument list of the declaration specifier belonging to the
572 declaration identifier DECL-IDENTIFIER. If the arglist cannot be determined,
573 the keyword :NOT-AVAILABLE is returned.
574
575 The different SWANK backends can specialize this generic function to
576 include implementation-dependend declaration specifiers, or to provide
577 additional information on the specifiers defined in ANSI Common Lisp.")
578 (:method (decl-identifier)
579 (case decl-identifier
580 (dynamic-extent '(&rest variables))
581 (ignore '(&rest variables))
582 (ignorable '(&rest variables))
583 (special '(&rest variables))
584 (inline '(&rest function-names))
585 (notinline '(&rest function-names))
586 (declaration '(&rest names))
587 (optimize '(&any compilation-speed debug safety space speed))
588 (type '(type-specifier &rest args))
589 (ftype '(type-specifier &rest function-names))
590 (otherwise
591 (flet ((typespec-p (symbol) (member :type (describe-symbol-for-emacs symbol))))
592 (cond ((and (symbolp decl-identifier) (typespec-p decl-identifier))
593 '(&rest variables))
594 ((and (listp decl-identifier) (typespec-p (first decl-identifier)))
595 '(&rest variables))
596 (t :not-available)))))))
597
598 (defgeneric type-specifier-arglist (typespec-operator)
599 (:documentation
600 "Return the argument list of the type specifier belonging to
601 TYPESPEC-OPERATOR.. If the arglist cannot be determined, the keyword
602 :NOT-AVAILABLE is returned.
603
604 The different SWANK backends can specialize this generic function to
605 include implementation-dependend declaration specifiers, or to provide
606 additional information on the specifiers defined in ANSI Common Lisp.")
607 (:method (typespec-operator)
608 (declare (special *type-specifier-arglists*)) ; defined at end of file.
609 (typecase typespec-operator
610 (symbol (or (cdr (assoc typespec-operator *type-specifier-arglists*))
611 :not-available))
612 (t :not-available))))
613
614 (definterface function-name (function)
615 "Return the name of the function object FUNCTION.
616
617 The result is either a symbol, a list, or NIL if no function name is available."
618 (declare (ignore function))
619 nil)
620
621 (definterface valid-function-name-p (form)
622 "Is FORM syntactically valid to name a function?
623 If true, FBOUNDP should not signal a type-error for FORM."
624 (flet ((length=2 (list)
625 (and (not (null (cdr list))) (null (cddr list)))))
626 (or (symbolp form)
627 (and (consp form) (length=2 form)
628 (eq (first form) 'setf) (symbolp (second form))))))
629
630 (definterface macroexpand-all (form)
631 "Recursively expand all macros in FORM.
632 Return the resulting form.")
633
634 (definterface compiler-macroexpand-1 (form &optional env)
635 "Call the compiler-macro for form.
636 If FORM is a function call for which a compiler-macro has been
637 defined, invoke the expander function using *macroexpand-hook* and
638 return the results and T. Otherwise, return the original form and
639 NIL."
640 (let ((fun (and (consp form)
641 (valid-function-name-p (car form))
642 (compiler-macro-function (car form)))))
643 (if fun
644 (let ((result (funcall *macroexpand-hook* fun form env)))
645 (values result (not (eq result form))))
646 (values form nil))))
647
648 (definterface compiler-macroexpand (form &optional env)
649 "Repetitively call `compiler-macroexpand-1'."
650 (labels ((frob (form expanded)
651 (multiple-value-bind (new-form newly-expanded)
652 (compiler-macroexpand-1 form env)
653 (if newly-expanded
654 (frob new-form t)
655 (values new-form expanded)))))
656 (frob form env)))
657
658 (definterface format-string-expand (control-string)
659 "Expand the format string CONTROL-STRING."
660 (macroexpand `(formatter ,control-string)))
661
662 (definterface describe-symbol-for-emacs (symbol)
663 "Return a property list describing SYMBOL.
664
665 The property list has an entry for each interesting aspect of the
666 symbol. The recognised keys are:
667
668 :VARIABLE :FUNCTION :SETF :SPECIAL-OPERATOR :MACRO :COMPILER-MACRO
669 :TYPE :CLASS :ALIEN-TYPE :ALIEN-STRUCT :ALIEN-UNION :ALIEN-ENUM
670
671 The value of each property is the corresponding documentation string,
672 or :NOT-DOCUMENTED. It is legal to include keys not listed here (but
673 slime-print-apropos in Emacs must know about them).
674
675 Properties should be included if and only if they are applicable to
676 the symbol. For example, only (and all) fbound symbols should include
677 the :FUNCTION property.
678
679 Example:
680 \(describe-symbol-for-emacs 'vector)
681 => (:CLASS :NOT-DOCUMENTED
682 :TYPE :NOT-DOCUMENTED
683 :FUNCTION \"Constructs a simple-vector from the given objects.\")")
684
685 (definterface describe-definition (name type)
686 "Describe the definition NAME of TYPE.
687 TYPE can be any value returned by DESCRIBE-SYMBOL-FOR-EMACS.
688
689 Return a documentation string, or NIL if none is available.")
690
691
692 ;;;; Debugging
693
694 (definterface install-debugger-globally (function)
695 "Install FUNCTION as the debugger for all threads/processes. This
696 usually involves setting *DEBUGGER-HOOK* and, if the implementation
697 permits, hooking into BREAK as well."
698 (setq *debugger-hook* function))
699
700 (definterface call-with-debugging-environment (debugger-loop-fn)
701 "Call DEBUGGER-LOOP-FN in a suitable debugging environment.
702
703 This function is called recursively at each debug level to invoke the
704 debugger loop. The purpose is to setup any necessary environment for
705 other debugger callbacks that will be called within the debugger loop.
706
707 For example, this is a reasonable place to compute a backtrace, switch
708 to safe reader/printer settings, and so on.")
709
710 (definterface call-with-debugger-hook (hook fun)
711 "Call FUN and use HOOK as debugger hook. HOOK can be NIL.
712
713 HOOK should be called for both BREAK and INVOKE-DEBUGGER."
714 (let ((*debugger-hook* hook))
715 (funcall fun)))
716
717 (define-condition sldb-condition (condition)
718 ((original-condition
719 :initarg :original-condition
720 :accessor original-condition))
721 (:report (lambda (condition stream)
722 (format stream "Condition in debugger code~@[: ~A~]"
723 (original-condition condition))))
724 (:documentation
725 "Wrapper for conditions that should not be debugged.
726
727 When a condition arises from the internals of the debugger, it is not
728 desirable to debug it -- we'd risk entering an endless loop trying to
729 debug the debugger! Instead, such conditions can be reported to the
730 user without (re)entering the debugger by wrapping them as
731 `sldb-condition's."))
732
733 ;;; The following functions in this section are supposed to be called
734 ;;; within the dynamic contour of CALL-WITH-DEBUGGING-ENVIRONMENT only.
735
736 (definterface compute-backtrace (start end)
737 "Returns a backtrace of the condition currently being debugged,
738 that is an ordered list consisting of frames. ``Ordered list''
739 means that an integer I can be mapped back to the i-th frame of this
740 backtrace.
741
742 START and END are zero-based indices constraining the number of frames
743 returned. Frame zero is defined as the frame which invoked the
744 debugger. If END is nil, return the frames from START to the end of
745 the stack.")
746
747 (definterface print-frame (frame stream)
748 "Print frame to stream.")
749
750 (definterface frame-restartable-p (frame)
751 "Is the frame FRAME restartable?.
752 Return T if `restart-frame' can safely be called on the frame."
753 (declare (ignore frame))
754 nil)
755
756 (definterface frame-source-location (frame-number)
757 "Return the source location for the frame associated to FRAME-NUMBER.")
758
759 (definterface frame-catch-tags (frame-number)
760 "Return a list of catch tags for being printed in a debugger stack
761 frame."
762 (declare (ignore frame-number))
763 '())
764
765 (definterface frame-locals (frame-number)
766 "Return a list of ((&key NAME ID VALUE) ...) where each element of
767 the list represents a local variable in the stack frame associated to
768 FRAME-NUMBER.
769
770 NAME, a symbol; the name of the local variable.
771
772 ID, an integer; used as primary key for the local variable, unique
773 relatively to the frame under operation.
774
775 value, an object; the value of the local variable.")
776
777 (definterface frame-var-value (frame-number var-id)
778 "Return the value of the local variable associated to VAR-ID
779 relatively to the frame associated to FRAME-NUMBER.")
780
781 (definterface disassemble-frame (frame-number)
782 "Disassemble the code for the FRAME-NUMBER.
783 The output should be written to standard output.
784 FRAME-NUMBER is a non-negative integer.")
785
786 (definterface eval-in-frame (form frame-number)
787 "Evaluate a Lisp form in the lexical context of a stack frame
788 in the debugger.
789
790 FRAME-NUMBER must be a positive integer with 0 indicating the
791 frame which invoked the debugger.
792
793 The return value is the result of evaulating FORM in the
794 appropriate context.")
795
796 (definterface frame-call (frame-number)
797 "Return a string representing a call to the entry point of a frame.")
798
799 (definterface return-from-frame (frame-number form)
800 "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
801 produced by evaluating FORM in the frame context to its caller.
802
803 Execute any clean-up code from unwind-protect forms above the frame
804 during unwinding.
805
806 Return a string describing the error if it's not possible to return
807 from the frame.")
808
809 (definterface restart-frame (frame-number)
810 "Restart execution of the frame FRAME-NUMBER with the same arguments
811 as it was called originally.")
812
813 (definterface format-sldb-condition (condition)
814 "Format a condition for display in SLDB."
815 (princ-to-string condition))
816
817 (definterface condition-extras (condition)
818 "Return a list of extra for the debugger.
819 The allowed elements are of the form:
820 (:SHOW-FRAME-SOURCE frame-number)
821 (:REFERENCES &rest refs)
822 "
823 (declare (ignore condition))
824 '())
825
826 (definterface gdb-initial-commands ()
827 "List of gdb commands supposed to be executed first for the
828 ATTACH-GDB restart."
829 nil)
830
831 (definterface activate-stepping (frame-number)
832 "Prepare the frame FRAME-NUMBER for stepping.")
833
834 (definterface sldb-break-on-return (frame-number)
835 "Set a breakpoint in the frame FRAME-NUMBER.")
836
837 (definterface sldb-break-at-start (symbol)
838 "Set a breakpoint on the beginning of the function for SYMBOL.")
839
840 (definterface sldb-stepper-condition-p (condition)
841 "Return true if SLDB was invoked due to a single-stepping condition,
842 false otherwise. "
843 (declare (ignore condition))
844 nil)
845
846 (definterface sldb-step-into ()
847 "Step into the current single-stepper form.")
848
849 (definterface sldb-step-next ()
850 "Step to the next form in the current function.")
851
852 (definterface sldb-step-out ()
853 "Stop single-stepping temporarily, but resume it once the current function
854 returns.")
855
856
857 ;;;; Definition finding
858
859 (defstruct (:location (:type list) :named
860 (:constructor make-location
861 (buffer position &optional hints)))
862 buffer position
863 ;; Hints is a property list optionally containing:
864 ;; :snippet SOURCE-TEXT
865 ;; This is a snippet of the actual source text at the start of
866 ;; the definition, which could be used in a text search.
867 hints)
868
869 (defstruct (:error (:type list) :named (:constructor)) message)
870
871 ;;; Valid content for BUFFER slot
872 (defstruct (:file (:type list) :named (:constructor)) name)
873 (defstruct (:buffer (:type list) :named (:constructor)) name)
874 (defstruct (:etags-file (:type list) :named (:constructor)) filename)
875
876 ;;; Valid content for POSITION slot
877 (defstruct (:position (:type list) :named (:constructor)) pos)
878 (defstruct (:tag (:type list) :named (:constructor)) tag1 tag2)
879
880 (defmacro converting-errors-to-error-location (&body body)
881 "Catches errors during BODY and converts them to an error location."
882 (let ((gblock (gensym "CONVERTING-ERRORS+")))
883 `(block ,gblock
884 (handler-bind ((error
885 #'(lambda (e)
886 (if *debug-swank-backend*
887 nil ;decline
888 (return-from ,gblock
889 (make-error-location e))))))
890 ,@body))))
891
892 (defun make-error-location (datum &rest args)
893 (cond ((typep datum 'condition)
894 `(:error ,(format nil "Error: ~A" datum)))
895 ((symbolp datum)
896 `(:error ,(format nil "Error: ~A" (apply #'make-condition datum args))))
897 (t
898 (assert (stringp datum))
899 `(:error ,(apply #'format nil datum args)))))
900
901 (definterface find-definitions (name)
902 "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
903
904 NAME is a \"definition specifier\".
905
906 DSPEC is a \"definition specifier\" describing the
907 definition, e.g., FOO or (METHOD FOO (STRING NUMBER)) or
908 \(DEFVAR FOO).
909
910 LOCATION is the source location for the definition.")
911
912 (definterface find-source-location (object)
913 "Returns the source location of OBJECT, or NIL.
914
915 That is the source location of the underlying datastructure of
916 OBJECT. E.g. on a STANDARD-OBJECT, the source location of the
917 respective DEFCLASS definition is returned, on a STRUCTURE-CLASS the
918 respective DEFSTRUCT definition, and so on."
919 ;; This returns one source location and not a list of locations. It's
920 ;; supposed to return the location of the DEFGENERIC definition on
921 ;; #'SOME-GENERIC-FUNCTION.
922 (declare (ignore object))
923 (make-error-location "FIND-DEFINITIONS is not yet implemented on ~
924 this implementation."))
925
926
927 (definterface buffer-first-change (filename)
928 "Called for effect the first time FILENAME's buffer is modified."
929 (declare (ignore filename))
930 nil)
931
932
933
934 ;;;; XREF
935
936 (definterface who-calls (function-name)
937 "Return the call sites of FUNCTION-NAME (a symbol).
938 The results is a list ((DSPEC LOCATION) ...)."
939 (declare (ignore function-name))
940 :not-implemented)
941
942 (definterface calls-who (function-name)
943 "Return the call sites of FUNCTION-NAME (a symbol).
944 The results is a list ((DSPEC LOCATION) ...)."
945 (declare (ignore function-name))
946 :not-implemented)
947
948 (definterface who-references (variable-name)
949 "Return the locations where VARIABLE-NAME (a symbol) is referenced.
950 See WHO-CALLS for a description of the return value."
951 (declare (ignore variable-name))
952 :not-implemented)
953
954 (definterface who-binds (variable-name)
955 "Return the locations where VARIABLE-NAME (a symbol) is bound.
956 See WHO-CALLS for a description of the return value."
957 (declare (ignore variable-name))
958 :not-implemented)
959
960 (definterface who-sets (variable-name)
961 "Return the locations where VARIABLE-NAME (a symbol) is set.
962 See WHO-CALLS for a description of the return value."
963 (declare (ignore variable-name))
964 :not-implemented)
965
966 (definterface who-macroexpands (macro-name)
967 "Return the locations where MACRO-NAME (a symbol) is expanded.
968 See WHO-CALLS for a description of the return value."
969 (declare (ignore macro-name))
970 :not-implemented)
971
972 (definterface who-specializes (class-name)
973 "Return the locations where CLASS-NAME (a symbol) is specialized.
974 See WHO-CALLS for a description of the return value."
975 (declare (ignore class-name))
976 :not-implemented)
977
978 ;;; Simpler variants.
979
980 (definterface list-callers (function-name)
981 "List the callers of FUNCTION-NAME.
982 This function is like WHO-CALLS except that it is expected to use
983 lower-level means. Whereas WHO-CALLS is usually implemented with
984 special compiler support, LIST-CALLERS is usually implemented by
985 groveling for constants in function objects throughout the heap.
986
987 The return value is as for WHO-CALLS.")
988
989 (definterface list-callees (function-name)
990 "List the functions called by FUNCTION-NAME.
991 See LIST-CALLERS for a description of the return value.")
992
993
994 ;;;; Profiling
995
996 ;;; The following functions define a minimal profiling interface.
997
998 (definterface profile (fname)
999 "Marks symbol FNAME for profiling.")
1000
1001 (definterface profiled-functions ()
1002 "Returns a list of profiled functions.")
1003
1004 (definterface unprofile (fname)
1005 "Marks symbol FNAME as not profiled.")
1006
1007 (definterface unprofile-all ()
1008 "Marks all currently profiled functions as not profiled."
1009 (dolist (f (profiled-functions))
1010 (unprofile f)))
1011
1012 (definterface profile-report ()
1013 "Prints profile report.")
1014
1015 (definterface profile-reset ()
1016 "Resets profile counters.")
1017
1018 (definterface profile-package (package callers-p methods)
1019 "Wrap profiling code around all functions in PACKAGE. If a function
1020 is already profiled, then unprofile and reprofile (useful to notice
1021 function redefinition.)
1022
1023 If CALLERS-P is T names have counts of the most common calling
1024 functions recorded.
1025
1026 When called with arguments :METHODS T, profile all methods of all
1027 generic functions having names in the given package. Generic functions
1028 themselves, that is, their dispatch functions, are left alone.")
1029
1030
1031 ;;;; Inspector
1032
1033 (defgeneric emacs-inspect (object)
1034 (:documentation
1035 "Explain to Emacs how to inspect OBJECT.
1036
1037 Returns a list specifying how to render the object for inspection.
1038
1039 Every element of the list must be either a string, which will be
1040 inserted into the buffer as is, or a list of the form:
1041
1042 (:value object &optional format) - Render an inspectable
1043 object. If format is provided it must be a string and will be
1044 rendered in place of the value, otherwise use princ-to-string.
1045
1046 (:newline) - Render a \\n
1047
1048 (:action label lambda &key (refresh t)) - Render LABEL (a text
1049 string) which when clicked will call LAMBDA. If REFRESH is
1050 non-NIL the currently inspected object will be re-inspected
1051 after calling the lambda.
1052 "))
1053
1054 (defmethod emacs-inspect ((object t))
1055 "Generic method for inspecting any kind of object.
1056
1057 Since we don't know how to deal with OBJECT we simply dump the
1058 output of CL:DESCRIBE."
1059 `("Type: " (:value ,(type-of object)) (:newline)
1060 "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
1061 (:newline) (:newline)
1062 ,(with-output-to-string (desc) (describe object desc))))
1063
1064 (definterface eval-context (object)
1065 "Return a list of bindings corresponding to OBJECT's slots."
1066 (declare (ignore object))
1067 '())
1068
1069 ;;; Utilities for inspector methods.
1070 ;;;
1071
1072 (defun label-value-line (label value &key (newline t))
1073 "Create a control list which prints \"LABEL: VALUE\" in the inspector.
1074 If NEWLINE is non-NIL a `(:newline)' is added to the result."
1075 (list* (princ-to-string label) ": " `(:value ,value)
1076 (if newline '((:newline)) nil)))
1077
1078 (defmacro label-value-line* (&rest label-values)
1079 ` (append ,@(loop for (label value) in label-values
1080 collect `(label-value-line ,label ,value))))
1081
1082 (definterface describe-primitive-type (object)
1083 "Return a string describing the primitive type of object."
1084 (declare (ignore object))
1085 "N/A")
1086
1087
1088 ;;;; Multithreading
1089 ;;;
1090 ;;; The default implementations are sufficient for non-multiprocessing
1091 ;;; implementations.
1092
1093 (definterface initialize-multiprocessing (continuation)
1094 "Initialize multiprocessing, if necessary and then invoke CONTINUATION.
1095
1096 Depending on the impleimentaion, this function may never return."
1097 (funcall continuation))
1098
1099 (definterface spawn (fn &key name)
1100 "Create a new thread to call FN.")
1101
1102 (definterface thread-id (thread)
1103 "Return an Emacs-parsable object to identify THREAD.
1104
1105 Ids should be comparable with equal, i.e.:
1106 (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)"
1107 thread)
1108
1109 (definterface find-thread (id)
1110 "Return the thread for ID.
1111 ID should be an id previously obtained with THREAD-ID.
1112 Can return nil if the thread no longer exists."
1113 (declare (ignore id))
1114 (current-thread))
1115
1116 (definterface thread-name (thread)
1117 "Return the name of THREAD.
1118 Thread names are short strings meaningful to the user. They do not
1119 have to be unique."
1120 (declare (ignore thread))
1121 "The One True Thread")
1122
1123 (definterface thread-status (thread)
1124 "Return a string describing THREAD's state."
1125 (declare (ignore thread))
1126 "")
1127
1128 (definterface thread-attributes (thread)
1129 "Return a plist of implementation-dependent attributes for THREAD"
1130 (declare (ignore thread))
1131 '())
1132
1133 (definterface make-lock (&key name)
1134 "Make a lock for thread synchronization.
1135 Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time
1136 but that thread may hold it more than once."
1137 (declare (ignore name))
1138 :null-lock)
1139
1140 (definterface call-with-lock-held (lock function)
1141 "Call FUNCTION with LOCK held, queueing if necessary."
1142 (declare (ignore lock)
1143 (type function function))
1144 (funcall function))
1145
1146 (definterface current-thread ()
1147 "Return the currently executing thread."
1148 0)
1149
1150 (definterface all-threads ()
1151 "Return a fresh list of all threads."
1152 '())
1153
1154 (definterface thread-alive-p (thread)
1155 "Test if THREAD is termintated."
1156 (member thread (all-threads)))
1157
1158 (definterface interrupt-thread (thread fn)
1159 "Cause THREAD to execute FN.")
1160
1161 (definterface kill-thread (thread)
1162 "Terminate THREAD immediately.
1163 Don't execute unwind-protected sections, don't raise conditions.
1164 (Do not pass go, do not collect $200.)"
1165 (declare (ignore thread))
1166 nil)
1167
1168 (definterface send (thread object)
1169 "Send OBJECT to thread THREAD.")
1170
1171 (definterface receive (&optional timeout)
1172 "Return the next message from current thread's mailbox."
1173 (receive-if (constantly t) timeout))
1174
1175 (definterface receive-if (predicate &optional timeout)
1176 "Return the first message satisfiying PREDICATE.")
1177
1178 (definterface set-default-initial-binding (var form)
1179 "Initialize special variable VAR by default with FORM.
1180
1181 Some implementations initialize certain variables in each newly
1182 created thread. This function sets the form which is used to produce
1183 the initial value."
1184 (set var (eval form)))
1185
1186 ;; List of delayed interrupts.
1187 ;; This should only have thread-local bindings, so no init form.
1188 (defvar *pending-slime-interrupts*)
1189
1190 (defun check-slime-interrupts ()
1191 "Execute pending interrupts if any.
1192 This should be called periodically in operations which
1193 can take a long time to complete.
1194 Return a boolean indicating whether any interrupts was processed."
1195 (when (and (boundp '*pending-slime-interrupts*)
1196 *pending-slime-interrupts*)
1197 (funcall (pop *pending-slime-interrupts*))
1198 t))
1199
1200 (defvar *interrupt-queued-handler* nil
1201 "Function to call on queued interrupts.
1202 Interrupts get queued when an interrupt occurs while interrupt
1203 handling is disabled.
1204
1205 Backends can use this function to abort slow operations.")
1206
1207 (definterface wait-for-input (streams &optional timeout)
1208 "Wait for input on a list of streams. Return those that are ready.
1209 STREAMS is a list of streams
1210 TIMEOUT nil, t, or real number. If TIMEOUT is t, return those streams
1211 which are ready (or have reached end-of-file) without waiting.
1212 If TIMEOUT is a number and no streams is ready after TIMEOUT seconds,
1213 return nil.
1214
1215 Return :interrupt if an interrupt occurs while waiting.")
1216
1217 ;; (assert (member timeout '(nil t)))
1218 ;; (cond #+(or)
1219 ;; ((null (cdr streams))
1220 ;; (wait-for-one-stream (car streams) timeout))
1221 ;; (t
1222 ;; (wait-for-streams streams timeout))))
1223
1224 (defun wait-for-streams (streams timeout)
1225 (loop
1226 (when (check-slime-interrupts) (return :interrupt))
1227 (let ((ready (remove-if-not #'stream-readable-p streams)))
1228 (when ready (return ready)))
1229 (when timeout (return nil))
1230 (sleep 0.1)))
1231
1232 ;; Note: Usually we can't interrupt PEEK-CHAR cleanly.
1233 (defun wait-for-one-stream (stream timeout)
1234 (ecase timeout
1235 ((nil)
1236 (cond ((check-slime-interrupts) :interrupt)
1237 (t (peek-char nil stream nil nil)
1238 (list stream))))
1239 ((t)
1240 (let ((c (read-char-no-hang stream nil nil)))
1241 (cond (c
1242 (unread-char c stream)
1243 (list stream))
1244 (t '()))))))
1245
1246 (defun stream-readable-p (stream)
1247 (let ((c (read-char-no-hang stream nil :eof)))
1248 (cond ((not c) nil)
1249 ((eq c :eof) t)
1250 (t (unread-char c stream) t))))
1251
1252 (definterface toggle-trace (spec)
1253 "Toggle tracing of the function(s) given with SPEC.
1254 SPEC can be:
1255 (setf NAME) ; a setf function
1256 (:defmethod NAME QUALIFIER... (SPECIALIZER...)) ; a specific method
1257 (:defgeneric NAME) ; a generic function with all methods
1258 (:call CALLER CALLEE) ; trace calls from CALLER to CALLEE.
1259 (:labels TOPLEVEL LOCAL)
1260 (:flet TOPLEVEL LOCAL) ")
1261
1262
1263 ;;;; Weak datastructures
1264
1265 (definterface make-weak-key-hash-table (&rest args)
1266 "Like MAKE-HASH-TABLE, but weak w.r.t. the keys."
1267 (apply #'make-hash-table args))
1268
1269 (definterface make-weak-value-hash-table (&rest args)
1270 "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
1271 (apply #'make-hash-table args))
1272
1273 (definterface hash-table-weakness (hashtable)
1274 "Return nil or one of :key :value :key-or-value :key-and-value"
1275 (declare (ignore hashtable))
1276 nil)
1277
1278
1279 ;;;; Character names
1280
1281 (definterface character-completion-set (prefix matchp)
1282 "Return a list of names of characters that match PREFIX."
1283 ;; Handle the standard and semi-standard characters.
1284 (loop for name in '("Newline" "Space" "Tab" "Page" "Rubout"
1285 "Linefeed" "Return" "Backspace")
1286 when (funcall matchp prefix name)
1287 collect name))
1288
1289
1290 (defparameter *type-specifier-arglists*
1291 '((and . (&rest type-specifiers))
1292 (array . (&optional element-type dimension-spec))
1293 (base-string . (&optional size))
1294 (bit-vector . (&optional size))
1295 (complex . (&optional type-specifier))
1296 (cons . (&optional car-typespec cdr-typespec))
1297 (double-float . (&optional lower-limit upper-limit))
1298 (eql . (object))
1299 (float . (&optional lower-limit upper-limit))
1300 (function . (&optional arg-typespec value-typespec))
1301 (integer . (&optional lower-limit upper-limit))
1302 (long-float . (&optional lower-limit upper-limit))
1303 (member . (&rest eql-objects))
1304 (mod . (n))
1305 (not . (type-specifier))
1306 (or . (&rest type-specifiers))
1307 (rational . (&optional lower-limit upper-limit))
1308 (real . (&optional lower-limit upper-limit))
1309 (satisfies . (predicate-symbol))
1310 (short-float . (&optional lower-limit upper-limit))
1311 (signed-byte . (&optional size))
1312 (simple-array . (&optional element-type dimension-spec))
1313 (simple-base-string . (&optional size))
1314 (simple-bit-vector . (&optional size))
1315 (simple-string . (&optional size))
1316 (single-float . (&optional lower-limit upper-limit))
1317 (simple-vector . (&optional size))
1318 (string . (&optional size))
1319 (unsigned-byte . (&optional size))
1320 (values . (&rest typespecs))
1321 (vector . (&optional element-type size))
1322 ))
1323
1324 ;;; Heap dumps
1325
1326 (definterface save-image (filename &optional restart-function)
1327 "Save a heap image to the file FILENAME.
1328 RESTART-FUNCTION, if non-nil, should be called when the image is loaded.")
1329
1330 (definterface background-save-image (filename &key restart-function
1331 completion-function)
1332 "Request saving a heap image to the file FILENAME.
1333 RESTART-FUNCTION, if non-nil, should be called when the image is loaded.
1334 COMPLETION-FUNCTION, if non-nil, should be called after saving the image.")
1335
1336 ;;; Codepoint length
1337
1338 (definterface codepoint-length (string)
1339 "Return the number of codepoints in STRING.
1340 With some Lisps, like cmucl, LENGTH returns the number of UTF-16 code
1341 units, but other Lisps return the number of codepoints. The slime
1342 protocol wants string lengths in terms of codepoints."
1343 (length string))
1344
1345 ;;; Timeouts
1346
1347 (definterface call-with-io-timeout (function &key seconds)
1348 "Calls function with the specified IO timeout."
1349 (declare (ignore seconds))
1350 (funcall function))

  ViewVC Help
Powered by ViewVC 1.1.5