/[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.94 by heller, Sun Nov 20 23:25:38 2005 UTC revision 1.194 by trittweiler, Mon Feb 22 21:38:46 2010 UTC
# Line 12  Line 12 
12    
13  (defpackage :swank-backend  (defpackage :swank-backend
14    (:use :common-lisp)    (:use :common-lisp)
15    (:export #:sldb-condition    (:export #:*debug-swank-backend*
16             #:original-condition             #:sldb-condition
17             #:compiler-condition             #:compiler-condition
18               #:original-condition
19             #:message             #:message
20             #:short-message             #:source-context
21             #:condition             #:condition
22             #:severity             #:severity
23               #:with-compilation-hooks
24             #:location             #:location
25             #:location-p             #:location-p
26             #:location-buffer             #:location-buffer
# Line 29  Line 31 
31             #:quit-lisp             #:quit-lisp
32             #:references             #:references
33             #:unbound-slot-filler             #:unbound-slot-filler
34               #:declaration-arglist
35               #:type-specifier-arglist
36               #:with-struct
37               ;; interrupt macro for the backend
38               #:*pending-slime-interrupts*
39               #:check-slime-interrupts
40               #:*interrupt-queued-handler*
41             ;; inspector related symbols             ;; inspector related symbols
42             #:inspector             #:emacs-inspect
            #:inspect-for-emacs  
            #:raw-inspection  
            #:fancy-inspection  
43             #:label-value-line             #:label-value-line
44             #:label-value-line*             #:label-value-line*
45             ))             #:with-symbol))
46    
47  (defpackage :swank-mop  (defpackage :swank-mop
48    (:use)    (:use)
# Line 84  Line 90 
90     #:slot-definition-type     #:slot-definition-type
91     #:slot-definition-readers     #:slot-definition-readers
92     #:slot-definition-writers     #:slot-definition-writers
93       #:slot-boundp-using-class
94       #:slot-value-using-class
95       #:slot-makunbound-using-class
96     ;; generic function protocol     ;; generic function protocol
97     #:compute-applicable-methods-using-classes     #:compute-applicable-methods-using-classes
98     #:finalize-inheritance))     #:finalize-inheritance))
# Line 93  Line 102 
102    
103  ;;;; Metacode  ;;;; Metacode
104    
105    (defparameter *debug-swank-backend* nil
106      "If this is true, backends should not catch errors but enter the
107    debugger where appropriate. Also, they should not perform backtrace
108    magic but really show every frame including SWANK related ones.")
109    
110  (defparameter *interface-functions* '()  (defparameter *interface-functions* '()
111    "The names of all interface functions.")    "The names of all interface functions.")
112    
# Line 102  DEFINTERFACE adds to this list and DEFIM Line 116  DEFINTERFACE adds to this list and DEFIM
116    
117  (defmacro definterface (name args documentation &rest default-body)  (defmacro definterface (name args documentation &rest default-body)
118    "Define an interface function for the backend to implement.    "Define an interface function for the backend to implement.
119  A generic function is defined with NAME, ARGS, and DOCUMENTATION.  A function is defined with NAME, ARGS, and DOCUMENTATION.  This
120    function first looks for a function to call in NAME's property list
121  If a DEFAULT-BODY is supplied then NO-APPLICABLE-METHOD is specialized  that is indicated by 'IMPLEMENTATION; failing that, it looks for a
122  to execute the body if the backend doesn't provide a specific  function indicated by 'DEFAULT. If neither is present, an error is
123  implementation.  signaled.
124    
125    If a DEFAULT-BODY is supplied, then a function with the same body and
126    ARGS will be added to NAME's property list as the property indicated
127    by 'DEFAULT.
128    
129  Backends implement these functions using DEFIMPLEMENTATION."  Backends implement these functions using DEFIMPLEMENTATION."
130    (check-type documentation string "a documentation string")    (check-type documentation string "a documentation string")
131    (flet ((gen-default-impl ()    (assert (every #'symbolp args) ()
132             `(defmethod ,name ,args ,@default-body)))            "Complex lambda-list not supported: ~S ~S" name args)
133      `(progn (defgeneric ,name ,args (:documentation ,documentation))    (labels ((gen-default-impl ()
134              (pushnew ',name *interface-functions*)               `(setf (get ',name 'default) (lambda ,args ,@default-body)))
135              ,(if (null default-body)             (args-as-list (args)
136                   `(pushnew ',name *unimplemented-interfaces*)               (destructuring-bind (req opt key rest) (parse-lambda-list args)
137                   (gen-default-impl))                 `(,@req ,@opt
138              ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>                         ,@(loop for k in key append `(,(kw k) ,k))
139              (eval-when (:compile-toplevel :load-toplevel :execute)                         ,@(or rest '(())))))
140                (export ',name :swank-backend))             (parse-lambda-list (args)
141              ',name)))               (parse args '(&optional &key &rest)
142                        (make-array 4 :initial-element nil)))
143               (parse (args keywords vars)
144                 (cond ((null args)
145                        (reverse (map 'list #'reverse vars)))
146                       ((member (car args) keywords)
147                        (parse (cdr args) (cdr (member (car args) keywords)) vars))
148                       (t (push (car args) (aref vars (length keywords)))
149                          (parse (cdr args) keywords vars))))
150               (kw (s) (intern (string s) :keyword)))
151        `(progn
152           (defun ,name ,args
153             ,documentation
154             (let ((f (or (get ',name 'implementation)
155                          (get ',name 'default))))
156               (cond (f (apply f ,@(args-as-list args)))
157                     (t (error "~S not implemented" ',name)))))
158           (pushnew ',name *interface-functions*)
159           ,(if (null default-body)
160                `(pushnew ',name *unimplemented-interfaces*)
161                (gen-default-impl))
162           ;; see <http://www.franz.com/support/documentation/6.2/doc/pages/variables/compiler/s_cltl1-compile-file-toplevel-compatibility-p_s.htm>
163           (eval-when (:compile-toplevel :load-toplevel :execute)
164             (export ',name :swank-backend))
165           ',name)))
166    
167  (defmacro defimplementation (name args &body body)  (defmacro defimplementation (name args &body body)
168    `(progn (defmethod ,name ,args ,@body)    (assert (every #'symbolp args) ()
169            (if (member ',name *interface-functions*)            "Complex lambda-list not supported: ~S ~S" name args)
170                (setq *unimplemented-interfaces*    `(progn
171                      (remove ',name *unimplemented-interfaces*))       (setf (get ',name 'implementation)
172                (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))             ;; For implicit BLOCK. FLET because of interplay w/ decls.
173            ',name))             (flet ((,name ,args ,@body)) #',name))
174         (if (member ',name *interface-functions*)
175             (setq *unimplemented-interfaces*
176                   (remove ',name *unimplemented-interfaces*))
177             (warn "DEFIMPLEMENTATION of undefined interface (~S)" ',name))
178         ',name))
179    
180  (defun warn-unimplemented-interfaces ()  (defun warn-unimplemented-interfaces ()
181    "Warn the user about unimplemented backend features.    "Warn the user about unimplemented backend features.
182  The portable code calls this function at startup."  The portable code calls this function at startup."
183    (warn "These Swank interfaces are unimplemented:~% ~A"    (let ((*print-pretty* t))
184          (sort (copy-list *unimplemented-interfaces*) #'string<)))      (warn "These Swank interfaces are unimplemented:~% ~:<~{~A~^ ~:_~}~:>"
185              (list (sort (copy-list *unimplemented-interfaces*) #'string<)))))
186    
187  (defun import-to-swank-mop (symbol-list)  (defun import-to-swank-mop (symbol-list)
188    (dolist (sym symbol-list)    (dolist (sym symbol-list)
# Line 158  EXCEPT is a list of symbol names which s Line 206  EXCEPT is a list of symbol names which s
206  (defvar *gray-stream-symbols*  (defvar *gray-stream-symbols*
207    '(:fundamental-character-output-stream    '(:fundamental-character-output-stream
208      :stream-write-char      :stream-write-char
209        :stream-write-string
210      :stream-fresh-line      :stream-fresh-line
211      :stream-force-output      :stream-force-output
212      :stream-finish-output      :stream-finish-output
213      :fundamental-character-input-stream      :fundamental-character-input-stream
214      :stream-read-char      :stream-read-char
215        :stream-peek-char
216        :stream-read-line
217        ;; STREAM-FILE-POSITION is not available on all implementations, or
218        ;; partially under a different name.
219        ; :stream-file-posiion
220      :stream-listen      :stream-listen
221      :stream-unread-char      :stream-unread-char
222      :stream-clear-input      :stream-clear-input
# Line 199  EXCEPT is a list of symbol names which s Line 253  EXCEPT is a list of symbol names which s
253                       (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))                       (t (error "Malformed syntax in WITH-STRUCT: ~A" name))))
254            ,@body)))))            ,@body)))))
255    
256    (defun with-symbol (name package)
257      "Generate a form suitable for testing with #+."
258      (if (find-symbol (string name) (string package))
259          '(:and)
260          '(:or)))
261    
262    
263  ;;;; TCP server  ;;;; TCP server
264    
# Line 212  EXCEPT is a list of symbol names which s Line 272  EXCEPT is a list of symbol names which s
272    "Close the socket SOCKET.")    "Close the socket SOCKET.")
273    
274  (definterface accept-connection (socket &key external-format  (definterface accept-connection (socket &key external-format
275                                          buffering)                                          buffering timeout)
276     "Accept a client connection on the listening socket SOCKET.     "Accept a client connection on the listening socket SOCKET.
277  Return a stream for the new connection.")  Return a stream for the new connection.")
278    
# Line 232  Return a stream for the new connection." Line 292  Return a stream for the new connection."
292    "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."    "Return one of the symbols :spawn, :sigio, :fd-handler, or NIL."
293    nil)    nil)
294    
295    (definterface set-stream-timeout (stream timeout)
296      "Set the 'stream 'timeout.  The timeout is either the real number
297      specifying the timeout in seconds or 'nil for no timeout."
298      (declare (ignore stream timeout))
299      nil)
300    
301  ;;; Base condition for networking errors.  ;;; Base condition for networking errors.
302  (define-condition network-error (simple-error) ())  (define-condition network-error (simple-error) ())
303    
# Line 249  that the calling thread is the one that Line 315  that the calling thread is the one that
315    
316  (defconstant +sigint+ 2)  (defconstant +sigint+ 2)
317    
 (definterface call-without-interrupts (fn)  
   "Call FN in a context where interrupts are disabled."  
   (funcall fn))  
   
318  (definterface getpid ()  (definterface getpid ()
319    "Return the (Unix) process ID of this superior Lisp.")    "Return the (Unix) process ID of this superior Lisp.")
320    
321    (definterface install-sigint-handler (function)
322      "Call FUNCTION on SIGINT (instead of invoking the debugger).
323    Return old signal handler."
324      (declare (ignore function))
325      nil)
326    
327    (definterface call-with-user-break-handler (handler function)
328      "Install the break handler HANDLER while executing FUNCTION."
329      (let ((old-handler (install-sigint-handler handler)))
330        (unwind-protect (funcall function)
331          (install-sigint-handler old-handler))))
332    
333    (definterface quit-lisp ()
334      "Exit the current lisp image.")
335    
336  (definterface lisp-implementation-type-name ()  (definterface lisp-implementation-type-name ()
337    "Return a short name for the Lisp implementation."    "Return a short name for the Lisp implementation."
338    (lisp-implementation-type))    (lisp-implementation-type))
339    
340    (definterface socket-fd (socket-stream)
341      "Return the file descriptor for SOCKET-STREAM.")
342    
343    (definterface make-fd-stream (fd external-format)
344      "Create a character stream for the file descriptor FD.")
345    
346    (definterface dup (fd)
347      "Duplicate a file descriptor.
348    If the syscall fails, signal a condition.
349    See dup(2).")
350    
351    (definterface exec-image (image-file args)
352      "Replace the current process with a new process image.
353    The new image is created by loading the previously dumped
354    core file IMAGE-FILE.
355    ARGS is a list of strings passed as arguments to
356    the new image.
357    This is thin wrapper around exec(3).")
358    
359    (definterface command-line-args ()
360      "Return a list of strings as passed by the OS.")
361    
362    
363    ;; pathnames are sooo useless
364    
365    (definterface filename-to-pathname (filename)
366      "Return a pathname for FILENAME.
367    A filename in Emacs may for example contain asterisks which should not
368    be translated to wildcards."
369      (parse-namestring filename))
370    
371    (definterface pathname-to-filename (pathname)
372      "Return the filename for PATHNAME."
373      (namestring pathname))
374    
375  (definterface default-directory ()  (definterface default-directory ()
376    "Return the default directory."    "Return the default directory."
377    (directory-namestring (truename *default-pathname-defaults*)))    (directory-namestring (truename *default-pathname-defaults*)))
# Line 270  This is used to resolve filenames withou Line 382  This is used to resolve filenames withou
382    (setf *default-pathname-defaults* (truename (merge-pathnames directory)))    (setf *default-pathname-defaults* (truename (merge-pathnames directory)))
383    (default-directory))    (default-directory))
384    
385    
386  (definterface call-with-syntax-hooks (fn)  (definterface call-with-syntax-hooks (fn)
387    "Call FN with hooks to handle special syntax."    "Call FN with hooks to handle special syntax."
388    (funcall fn))    (funcall fn))
# Line 278  This is used to resolve filenames withou Line 391  This is used to resolve filenames withou
391    "Return a suitable initial value for SWANK:*READTABLE-ALIST*."    "Return a suitable initial value for SWANK:*READTABLE-ALIST*."
392    '())    '())
393    
 (definterface quit-lisp ()  
   "Exit the current lisp image.")  
   
394    
395  ;;;; Compilation  ;;;; Compilation
396    
# Line 292  This is used to resolve filenames withou Line 402  This is used to resolve filenames withou
402    (declare (ignore ignore))    (declare (ignore ignore))
403    `(call-with-compilation-hooks (lambda () (progn ,@body))))    `(call-with-compilation-hooks (lambda () (progn ,@body))))
404    
405  (definterface swank-compile-string (string &key buffer position directory)  (definterface swank-compile-string (string &key buffer position filename
406    "Compile source from STRING.  During compilation, compiler                                             policy)
407  conditions must be trapped and resignalled as COMPILER-CONDITIONs.    "Compile source from STRING.
408    During compilation, compiler conditions must be trapped and
409    resignalled as COMPILER-CONDITIONs.
410    
411  If supplied, BUFFER and POSITION specify the source location in Emacs.  If supplied, BUFFER and POSITION specify the source location in Emacs.
412    
413  Additionally, if POSITION is supplied, it must be added to source  Additionally, if POSITION is supplied, it must be added to source
414  positions reported in compiler conditions.  positions reported in compiler conditions.
415    
416  If DIRECTORY is specified it may be used by certain implementations to  If FILENAME is specified it may be used by certain implementations to
417  rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of  rebind *DEFAULT-PATHNAME-DEFAULTS* which may improve the recording of
418  source information.")  source information.
419    
420  (definterface operate-on-system (system-name operation-name &rest keyword-args)  If POLICY is supplied, and non-NIL, it may be used by certain
421    "Perform OPERATION-NAME on SYSTEM-NAME using ASDF.  implementations to compile with a debug optimization quality of its
422  The KEYWORD-ARGS are passed on to the operation.  value.
423  Example:  
424  \(operate-on-system \"SWANK\" \"COMPILE-OP\" :force t)"  Should return T on successfull compilation, NIL otherwise.
425    (unless (member :asdf *features*)  ")
426      (error "ASDF is not loaded."))  
427    (with-compilation-hooks ()  (definterface swank-compile-file (input-file output-file load-p
428      (let ((operate (find-symbol "OPERATE" :asdf))                                               external-format)
429            (operation (find-symbol operation-name :asdf)))     "Compile INPUT-FILE signalling COMPILE-CONDITIONs.
430        (when (null operation)  If LOAD-P is true, load the file after compilation.
431          (error "Couldn't find ASDF operation ~S" operation-name))  EXTERNAL-FORMAT is a value returned by find-external-format or
432        (apply operate operation system-name keyword-args))))  :default.
433    
434  (definterface swank-compile-file (filename load-p &optional external-format)  Should return OUTPUT-TRUENAME, WARNINGS-P and FAILURE-p
435     "Compile FILENAME signalling COMPILE-CONDITIONs.  like `compile-file'")
 If LOAD-P is true, load the file after compilation.")  
436    
437  (deftype severity ()  (deftype severity ()
438    '(member :error :read-error :warning :style-warning :note))    '(member :error :read-error :warning :style-warning :note :redefinition))
439    
440  ;; Base condition type for compiler errors, warnings and notes.  ;; Base condition type for compiler errors, warnings and notes.
441  (define-condition compiler-condition (condition)  (define-condition compiler-condition (condition)
# Line 342  If LOAD-P is true, load the file after c Line 453  If LOAD-P is true, load the file after c
453     (message :initarg :message     (message :initarg :message
454              :accessor message)              :accessor message)
455    
456     (short-message :initarg :short-message     ;; Macro expansion history etc. which may be helpful in some cases
457                    :initform nil     ;; but is often very verbose.
458                    :accessor short-message)     (source-context :initarg :source-context
459                       :type (or null string)
460                       :initform nil
461                       :accessor source-context)
462    
463     (references :initarg :references     (references :initarg :references
464                 :initform nil                 :initform nil
# Line 353  If LOAD-P is true, load the file after c Line 467  If LOAD-P is true, load the file after c
467     (location :initarg :location     (location :initarg :location
468               :accessor location)))               :accessor location)))
469    
470    (definterface find-external-format (coding-system)
471      "Return a \"external file format designator\" for CODING-SYSTEM.
472    CODING-SYSTEM is Emacs-style coding system name (a string),
473    e.g. \"latin-1-unix\"."
474      (if (equal coding-system "iso-latin-1-unix")
475          :default
476          nil))
477    
478    (definterface guess-external-format (pathname)
479      "Detect the external format for the file with name pathname.
480    Return nil if the file contains no special markers."
481      ;; Look for a Emacs-style -*- coding: ... -*- or Local Variable: section.
482      (with-open-file (s pathname :if-does-not-exist nil
483                         :external-format (or (find-external-format "latin-1-unix")
484                                              :default))
485        (if s
486            (or (let* ((line (read-line s nil))
487                       (p (search "-*-" line)))
488                  (when p
489                    (let* ((start (+ p (length "-*-")))
490                           (end (search "-*-" line :start2 start)))
491                      (when end
492                        (%search-coding line start end)))))
493                (let* ((len (file-length s))
494                       (buf (make-string (min len 3000))))
495                  (file-position s (- len (length buf)))
496                  (read-sequence buf s)
497                  (let ((start (search "Local Variables:" buf :from-end t))
498                        (end (search "End:" buf :from-end t)))
499                    (and start end (< start end)
500                         (%search-coding buf start end))))))))
501    
502    (defun %search-coding (str start end)
503      (let ((p (search "coding:" str :start2 start :end2 end)))
504        (when p
505          (incf p (length "coding:"))
506          (loop while (and (< p end)
507                           (member (aref str p) '(#\space #\tab)))
508                do (incf p))
509          (let ((end (position-if (lambda (c) (find c '(#\space #\tab #\newline)))
510                                  str :start p)))
511            (find-external-format (subseq str p end))))))
512    
513    
514  ;;;; Streams  ;;;; Streams
515    
516  (definterface make-fn-streams (input-fn output-fn)  (definterface make-output-stream (write-string)
517     "Return character input and output streams backended by functions.    "Return a new character output stream.
518  When input is needed, INPUT-FN is called with no arguments to  The stream calls WRITE-STRING when output is ready.")
519  return a string.  
520  When output is ready, OUTPUT-FN is called with the output as its  (definterface make-input-stream (read-string)
521  argument.    "Return a new character input stream.
522    The stream calls READ-STRING when input is needed.")
 Output should be forced to OUTPUT-FN before calling INPUT-FN.  
   
 The streams are returned as two values.")  
   
 (definterface make-stream-interactive (stream)  
   "Do any necessary setup to make STREAM work interactively.  
 This is called for each stream used for interaction with the user  
 \(e.g. *standard-output*). An implementation could setup some  
 implementation-specific functions to control output flushing at the  
 like."  
   (declare (ignore stream))  
   nil)  
523    
524    
525  ;;;; Documentation  ;;;; Documentation
# Line 383  like." Line 528  like."
528     "Return the lambda list for the symbol NAME. NAME can also be     "Return the lambda list for the symbol NAME. NAME can also be
529  a lisp function object, on lisps which support this.  a lisp function object, on lisps which support this.
530    
531  The result can be a list or the :not-available if the arglist  The result can be a list or the :not-available keyword if the
532  cannot be determined."  arglist cannot be determined."
533     (declare (ignore name))     (declare (ignore name))
534     :not-available)     :not-available)
535    
536    (defgeneric declaration-arglist (decl-identifier)
537      (:documentation
538       "Return the argument list of the declaration specifier belonging to the
539    declaration identifier DECL-IDENTIFIER. If the arglist cannot be determined,
540    the keyword :NOT-AVAILABLE is returned.
541    
542    The different SWANK backends can specialize this generic function to
543    include implementation-dependend declaration specifiers, or to provide
544    additional information on the specifiers defined in ANSI Common Lisp.")
545      (:method (decl-identifier)
546        (case decl-identifier
547          (dynamic-extent '(&rest variables))
548          (ignore         '(&rest variables))
549          (ignorable      '(&rest variables))
550          (special        '(&rest variables))
551          (inline         '(&rest function-names))
552          (notinline      '(&rest function-names))
553          (declaration    '(&rest names))
554          (optimize       '(&any compilation-speed debug safety space speed))
555          (type           '(type-specifier &rest args))
556          (ftype          '(type-specifier &rest function-names))
557          (otherwise
558           (flet ((typespec-p (symbol) (member :type (describe-symbol-for-emacs symbol))))
559             (cond ((and (symbolp decl-identifier) (typespec-p decl-identifier))
560                    '(&rest variables))
561                   ((and (listp decl-identifier) (typespec-p (first decl-identifier)))
562                    '(&rest variables))
563                   (t :not-available)))))))
564    
565    (defgeneric type-specifier-arglist (typespec-operator)
566      (:documentation
567       "Return the argument list of the type specifier belonging to
568    TYPESPEC-OPERATOR.. If the arglist cannot be determined, the keyword
569    :NOT-AVAILABLE is returned.
570    
571    The different SWANK backends can specialize this generic function to
572    include implementation-dependend declaration specifiers, or to provide
573    additional information on the specifiers defined in ANSI Common Lisp.")
574      (:method (typespec-operator)
575        (declare (special *type-specifier-arglists*)) ; defined at end of file.
576        (typecase typespec-operator
577          (symbol (or (cdr (assoc typespec-operator *type-specifier-arglists*))
578                      :not-available))
579          (t :not-available))))
580    
581  (definterface function-name (function)  (definterface function-name (function)
582    "Return the name of the function object FUNCTION.    "Return the name of the function object FUNCTION.
583    
# Line 421  NIL." Line 611  NIL."
611                     (values new-form expanded)))))                     (values new-form expanded)))))
612      (frob form env)))      (frob form env)))
613    
614    (definterface format-string-expand (control-string)
615      "Expand the format string CONTROL-STRING."
616      (macroexpand `(formatter ,control-string)))
617    
618  (definterface describe-symbol-for-emacs (symbol)  (definterface describe-symbol-for-emacs (symbol)
619     "Return a property list describing SYMBOL.     "Return a property list describing SYMBOL.
620    
# Line 470  For example, this is a reasonable place Line 664  For example, this is a reasonable place
664  to safe reader/printer settings, and so on.")  to safe reader/printer settings, and so on.")
665    
666  (definterface call-with-debugger-hook (hook fun)  (definterface call-with-debugger-hook (hook fun)
667    "Call FUN and use HOOK as debugger hook.    "Call FUN and use HOOK as debugger hook. HOOK can be NIL.
668    
669  HOOK should be called for both BREAK and INVOKE-DEBUGGER."  HOOK should be called for both BREAK and INVOKE-DEBUGGER."
670    (let ((*debugger-hook* hook))    (let ((*debugger-hook* hook))
# Line 492  debug the debugger! Instead, such condit Line 686  debug the debugger! Instead, such condit
686  user without (re)entering the debugger by wrapping them as  user without (re)entering the debugger by wrapping them as
687  `sldb-condition's."))  `sldb-condition's."))
688    
689    ;;; The following functions in this section are supposed to be called
690    ;;; within the dynamic contour of CALL-WITH-DEBUGGING-ENVIRONMENT only.
691    
692  (definterface compute-backtrace (start end)  (definterface compute-backtrace (start end)
693     "Return a list containing a backtrace of the condition current     "Returns a backtrace of the condition currently being debugged,
694  being debugged.  The results are unspecified if this function is  that is an ordered list consisting of frames. ``Ordered list''
695  called outside the dynamic contour CALL-WITH-DEBUGGING-ENVIRONMENT.  means that an integer I can be mapped back to the i-th frame of this
696    backtrace.
697    
698  START and END are zero-based indices constraining the number of frames  START and END are zero-based indices constraining the number of frames
699  returned.  Frame zero is defined as the frame which invoked the  returned. Frame zero is defined as the frame which invoked the
700  debugger.  If END is nil, return the frames from START to the end of  debugger. If END is nil, return the frames from START to the end of
701  the stack.")  the stack.")
702    
703  (definterface print-frame (frame stream)  (definterface print-frame (frame stream)
704    "Print frame to stream.")    "Print frame to stream.")
705    
706  (definterface frame-source-location-for-emacs (frame-number)  (definterface frame-restartable-p (frame)
707    "Return the source location for FRAME-NUMBER.")    "Is the frame FRAME restartable?.
708    Return T if `restart-frame' can safely be called on the frame."
709      (declare (ignore frame))
710      nil)
711    
712    (definterface frame-source-location (frame-number)
713      "Return the source location for the frame associated to FRAME-NUMBER.")
714    
715  (definterface frame-catch-tags (frame-number)  (definterface frame-catch-tags (frame-number)
716    "Return a list of XXX list of what? catch tags for a debugger    "Return a list of catch tags for being printed in a debugger stack
717  stack frame.  The results are undefined unless this is called  frame."
718  within the dynamic contour of a function defined by    (declare (ignore frame-number))
719  DEFINE-DEBUGGER-HOOK.")    '())
720    
721  (definterface frame-locals (frame-number)  (definterface frame-locals (frame-number)
722    "Return a list of XXX local variable designators define me    "Return a list of ((&key NAME ID VALUE) ...) where each element of
723  for a debugger stack frame.  The results are undefined unless  the list represents a local variable in the stack frame associated to
724  this is called within the dynamic contour of a function defined  FRAME-NUMBER.
725  by DEFINE-DEBUGGER-HOOK.")  
726    NAME, a symbol; the name of the local variable.
727  (definterface frame-var-value (frame var)  
728    "Return the value of VAR in FRAME.  ID, an integer; used as primary key for the local variable, unique
729  FRAME is the number of the frame in the backtrace.  relatively to the frame under operation.
730  VAR is the number of the variable in the frame.")  
731    value, an object; the value of the local variable.")
732    
733    (definterface frame-var-value (frame-number var-id)
734      "Return the value of the local variable associated to VAR-ID
735    relatively to the frame associated to FRAME-NUMBER.")
736    
737  (definterface disassemble-frame (frame-number)  (definterface disassemble-frame (frame-number)
738    "Disassemble the code for the FRAME-NUMBER.    "Disassemble the code for the FRAME-NUMBER.
# Line 532  FRAME-NUMBER is a non-negative integer." Line 741  FRAME-NUMBER is a non-negative integer."
741    
742  (definterface eval-in-frame (form frame-number)  (definterface eval-in-frame (form frame-number)
743     "Evaluate a Lisp form in the lexical context of a stack frame     "Evaluate a Lisp form in the lexical context of a stack frame
744  in the debugger.  The results are undefined unless called in the  in the debugger.
 dynamic contour of a function defined by DEFINE-DEBUGGER-HOOK.  
745    
746  FRAME-NUMBER must be a positive integer with 0 indicating the  FRAME-NUMBER must be a positive integer with 0 indicating the
747  frame which invoked the debugger.  frame which invoked the debugger.
# Line 541  frame which invoked the debugger. Line 749  frame which invoked the debugger.
749  The return value is the result of evaulating FORM in the  The return value is the result of evaulating FORM in the
750  appropriate context.")  appropriate context.")
751    
752    (definterface frame-call (frame-number)
753      "Return a string representing a call to the entry point of a frame.")
754    
755  (definterface return-from-frame (frame-number form)  (definterface return-from-frame (frame-number form)
756    "Unwind the stack to the frame FRAME-NUMBER and return the value(s)    "Unwind the stack to the frame FRAME-NUMBER and return the value(s)
757  produced by evaluating FORM in the frame context to its caller.  produced by evaluating FORM in the frame context to its caller.
# Line 559  as it was called originally.") Line 770  as it was called originally.")
770    "Format a condition for display in SLDB."    "Format a condition for display in SLDB."
771    (princ-to-string condition))    (princ-to-string condition))
772    
 (definterface condition-references (condition)  
   "Return a list of documentation references for a condition.  
 Each reference is one of:  
   (:ANSI-CL  
    {:FUNCTION | :SPECIAL-OPERATOR | :MACRO | :SECTION | :GLOSSARY }  
    symbol-or-name)  
   (:SBCL :NODE node-name)"  
   (declare (ignore condition))  
   '())  
   
773  (definterface condition-extras (condition)  (definterface condition-extras (condition)
774    "Return a list of extra for the debugger.    "Return a list of extra for the debugger.
775  The allowed elements are of the form:  The allowed elements are of the form:
776    (:SHOW-FRAME-SOURCE frame-number)"    (:SHOW-FRAME-SOURCE frame-number)
777      (:REFERENCES &rest refs)
778    "
779    (declare (ignore condition))    (declare (ignore condition))
780    '())    '())
781    
# Line 585  The allowed elements are of the form: Line 788  The allowed elements are of the form:
788  (definterface sldb-break-at-start (symbol)  (definterface sldb-break-at-start (symbol)
789    "Set a breakpoint on the beginning of the function for SYMBOL.")    "Set a breakpoint on the beginning of the function for SYMBOL.")
790    
791    (definterface sldb-stepper-condition-p (condition)
792      "Return true if SLDB was invoked due to a single-stepping condition,
793    false otherwise. "
794      (declare (ignore condition))
795      nil)
796    
797    (definterface sldb-step-into ()
798      "Step into the current single-stepper form.")
799    
800    (definterface sldb-step-next ()
801      "Step to the next form in the current function.")
802    
803    (definterface sldb-step-out ()
804      "Stop single-stepping temporarily, but resume it once the current function
805    returns.")
806    
807    
808  ;;;; Definition finding  ;;;; Definition finding
# Line 600  The allowed elements are of the form: Line 818  The allowed elements are of the form:
818    hints)    hints)
819    
820  (defstruct (:error (:type list) :named (:constructor)) message)  (defstruct (:error (:type list) :named (:constructor)) message)
821  (defstruct (:file (:type list) :named (:constructor)) name)  
822  (defstruct (:buffer (:type list) :named (:constructor)) name)  ;;; Valid content for BUFFER slot
823    (defstruct (:file       (:type list) :named (:constructor)) name)
824    (defstruct (:buffer     (:type list) :named (:constructor)) name)
825    (defstruct (:etags-file (:type list) :named (:constructor)) filename)
826    
827    ;;; Valid content for POSITION slot
828  (defstruct (:position (:type list) :named (:constructor)) pos)  (defstruct (:position (:type list) :named (:constructor)) pos)
829    (defstruct (:tag      (:type list) :named (:constructor)) tag1 tag2)
830    
831    (defmacro converting-errors-to-error-location (&body body)
832      "Catches errors during BODY and converts them to an error location."
833      (let ((gblock (gensym "CONVERTING-ERRORS+")))
834        `(block ,gblock
835           (handler-bind ((error
836                           #'(lambda (e)
837                                (if *debug-swank-backend*
838                                    nil     ;decline
839                                    (return-from ,gblock
840                                      (make-error-location e))))))
841             ,@body))))
842    
843    (defun make-error-location (datum &rest args)
844      (cond ((typep datum 'condition)
845             `(:error ,(format nil "Error: ~A" datum)))
846            ((symbolp datum)
847             `(:error ,(format nil "Error: ~A" (apply #'make-condition datum args))))
848            (t
849             (assert (stringp datum))
850             `(:error ,(apply #'format nil datum args)))))
851    
852  (definterface find-definitions (name)  (definterface find-definitions (name)
853     "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.     "Return a list ((DSPEC LOCATION) ...) for NAME's definitions.
# Line 615  definition, e.g., FOO or (METHOD FOO (ST Line 860  definition, e.g., FOO or (METHOD FOO (ST
860    
861  LOCATION is the source location for the definition.")  LOCATION is the source location for the definition.")
862    
863    (definterface find-source-location (object)
864      "Returns the source location of OBJECT, or NIL.
865    
866    That is the source location of the underlying datastructure of
867    OBJECT. E.g. on a STANDARD-OBJECT, the source location of the
868    respective DEFCLASS definition is returned, on a STRUCTURE-CLASS the
869    respective DEFSTRUCT definition, and so on."
870      ;; This returns one source location and not a list of locations. It's
871      ;; supposed to return the location of the DEFGENERIC definition on
872      ;; #'SOME-GENERIC-FUNCTION.
873      (declare (ignore object))
874      (make-error-location "FIND-DEFINITIONS is not yet implemented on ~
875                            this implementation."))
876    
877    
878  (definterface buffer-first-change (filename)  (definterface buffer-first-change (filename)
879    "Called for effect the first time FILENAME's buffer is modified."    "Called for effect the first time FILENAME's buffer is modified."
880    (declare (ignore filename))    (declare (ignore filename))
881    nil)    nil)
882    
883    
884    
885  ;;;; XREF  ;;;; XREF
886    
887  (definterface who-calls (function-name)  (definterface who-calls (function-name)
888    "Return the call sites of FUNCTION-NAME (a symbol).    "Return the call sites of FUNCTION-NAME (a symbol).
889  The results is a list ((DSPEC LOCATION) ...).")  The results is a list ((DSPEC LOCATION) ...)."
890      (declare (ignore function-name))
891      :not-implemented)
892    
893  (definterface calls-who (function-name)  (definterface calls-who (function-name)
894    "Return the call sites of FUNCTION-NAME (a symbol).    "Return the call sites of FUNCTION-NAME (a symbol).
895  The results is a list ((DSPEC LOCATION) ...).")  The results is a list ((DSPEC LOCATION) ...)."
896      (declare (ignore function-name))
897      :not-implemented)
898    
899  (definterface who-references (variable-name)  (definterface who-references (variable-name)
900    "Return the locations where VARIABLE-NAME (a symbol) is referenced.    "Return the locations where VARIABLE-NAME (a symbol) is referenced.
901  See WHO-CALLS for a description of the return value.")  See WHO-CALLS for a description of the return value."
902      (declare (ignore variable-name))
903      :not-implemented)
904    
905  (definterface who-binds (variable-name)  (definterface who-binds (variable-name)
906    "Return the locations where VARIABLE-NAME (a symbol) is bound.    "Return the locations where VARIABLE-NAME (a symbol) is bound.
907  See WHO-CALLS for a description of the return value.")  See WHO-CALLS for a description of the return value."
908      (declare (ignore variable-name))
909      :not-implemented)
910    
911  (definterface who-sets (variable-name)  (definterface who-sets (variable-name)
912    "Return the locations where VARIABLE-NAME (a symbol) is set.    "Return the locations where VARIABLE-NAME (a symbol) is set.
913  See WHO-CALLS for a description of the return value.")  See WHO-CALLS for a description of the return value."
914      (declare (ignore variable-name))
915      :not-implemented)
916    
917  (definterface who-macroexpands (macro-name)  (definterface who-macroexpands (macro-name)
918    "Return the locations where MACRO-NAME (a symbol) is expanded.    "Return the locations where MACRO-NAME (a symbol) is expanded.
919  See WHO-CALLS for a description of the return value.")  See WHO-CALLS for a description of the return value."
920      (declare (ignore macro-name))
921      :not-implemented)
922    
923  (definterface who-specializes (class-name)  (definterface who-specializes (class-name)
924    "Return the locations where CLASS-NAME (a symbol) is specialized.    "Return the locations where CLASS-NAME (a symbol) is specialized.
925  See WHO-CALLS for a description of the return value.")  See WHO-CALLS for a description of the return value."
926      (declare (ignore class-name))
927      :not-implemented)
928    
929  ;;; Simpler variants.  ;;; Simpler variants.
930    
# Line 706  themselves, that is, their dispatch func Line 981  themselves, that is, their dispatch func
981    
982  ;;;; Inspector  ;;;; Inspector
983    
984  (defclass inspector ()  (defgeneric emacs-inspect (object)
985    ()    (:documentation
   (:documentation "Super class of inspector objects.  
   
 Implementations should sub class in order to dispatch off of the  
 inspect-for-emacs method."))  
   
 (definterface make-default-inspector ()  
   "Return an inspector object suitable for passing to inspect-for-emacs.")  
   
 (definterface inspect-for-emacs (object inspector)  
986     "Explain to Emacs how to inspect OBJECT.     "Explain to Emacs how to inspect OBJECT.
987    
988  The argument INSPECTOR is an object representing how to get at  Returns a list specifying how to render the object for inspection.
 the internals of OBJECT, it is usually an implementation specific  
 class used simply for dispatching to the proper method.  
   
 The orgument INSPECTION-MODE is an object specifying how, and  
 what, to show to the user.  
   
 Returns two values: a string which will be used as the title of  
 the inspector buffer and a list specifying how to render the  
 object for inspection.  
989    
990  Every element of the list must be either a string, which will be  Every element of the list must be either a string, which will be
991  inserted into the buffer as is, or a list of the form:  inserted into the buffer as is, or a list of the form:
# Line 739  inserted into the buffer as is, or a lis Line 996  inserted into the buffer as is, or a lis
996    
997   (:newline) - Render a \\n   (:newline) - Render a \\n
998    
999   (:action label lambda) - Render LABEL (a text string) which when   (:action label lambda &key (refresh t)) - Render LABEL (a text
1000   clicked will call LAMBDA.   string) which when clicked will call LAMBDA. If REFRESH is
1001     non-NIL the currently inspected object will be re-inspected
1002   NIL - do nothing.")   after calling the lambda.
1003    "))
1004    
1005  (defmethod inspect-for-emacs ((object t) (inspector t))  (defmethod emacs-inspect ((object t))
1006    "Generic method for inspecting any kind of object.    "Generic method for inspecting any kind of object.
1007    
1008  Since we don't know how to deal with OBJECT we simply dump the  Since we don't know how to deal with OBJECT we simply dump the
1009  output of CL:DESCRIBE."  output of CL:DESCRIBE."
   (declare (ignore inspector))  
   (values  
    "A value."  
1010     `("Type: " (:value ,(type-of object)) (:newline)     `("Type: " (:value ,(type-of object)) (:newline)
1011       "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"       "Don't know how to inspect the object, dumping output of CL:DESCRIBE:"
1012       (:newline) (:newline)       (:newline) (:newline)
1013       ,(with-output-to-string (desc) (describe object desc)))))       ,(with-output-to-string (desc) (describe object desc))))
1014    
1015    (definterface eval-context (object)
1016      "Return a list of bindings corresponding to OBJECT's slots."
1017      (declare (ignore object))
1018      '())
1019    
1020  ;;; Utilities for inspector methods.  ;;; Utilities for inspector methods.
1021  ;;;  ;;;
1022  (defun label-value-line (label value)  
1023    "Create a control list which prints \"LABEL: VALUE\" in the inspector."  (defun label-value-line (label value &key (newline t))
1024    (list (princ-to-string label) ": " `(:value ,value) '(:newline)))    "Create a control list which prints \"LABEL: VALUE\" in the inspector.
1025    If NEWLINE is non-NIL a `(:newline)' is added to the result."
1026    
1027      (list* (princ-to-string label) ": " `(:value ,value)
1028             (if newline '((:newline)) nil)))
1029    
1030  (defmacro label-value-line* (&rest label-values)  (defmacro label-value-line* (&rest label-values)
1031    ` (append ,@(loop for (label value) in label-values    ` (append ,@(loop for (label value) in label-values
# Line 778  output of CL:DESCRIBE." Line 1042  output of CL:DESCRIBE."
1042  ;;; The default implementations are sufficient for non-multiprocessing  ;;; The default implementations are sufficient for non-multiprocessing
1043  ;;; implementations.  ;;; implementations.
1044    
1045  (definterface initialize-multiprocessing ()  (definterface initialize-multiprocessing (continuation)
1046     "Initialize multiprocessing, if necessary."     "Initialize multiprocessing, if necessary and then invoke CONTINUATION.
    nil)  
1047    
1048  (definterface startup-idle-and-top-level-loops ()  Depending on the impleimentaion, this function may never return."
1049    "This function is called directly through the listener, not in an RPC     (funcall continuation))
 from Emacs. This is to support interfaces such as CMUCL's  
 MP::STARTUP-IDLE-AND-TOP-LEVEL-LOOPS which does not return like a  
 normal function."  
    nil)  
1050    
1051  (definterface spawn (fn &key name)  (definterface spawn (fn &key name)
1052    "Create a new thread to call FN.")    "Create a new thread to call FN.")
# Line 796  normal function." Line 1055  normal function."
1055    "Return an Emacs-parsable object to identify THREAD.    "Return an Emacs-parsable object to identify THREAD.
1056    
1057  Ids should be comparable with equal, i.e.:  Ids should be comparable with equal, i.e.:
1058   (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)")   (equal (thread-id <t1>) (thread-id <t2>)) <==> (eq <t1> <t2>)"
1059      thread)
1060    
1061  (definterface find-thread (id)  (definterface find-thread (id)
1062    "Return the thread for ID.    "Return the thread for ID.
1063  ID should be an id previously obtained with THREAD-ID.  ID should be an id previously obtained with THREAD-ID.
1064  Can return nil if the thread no longer exists.")  Can return nil if the thread no longer exists."
1065      (declare (ignore id))
1066      (current-thread))
1067    
1068  (definterface thread-name (thread)  (definterface thread-name (thread)
1069     "Return the name of THREAD.     "Return the name of THREAD.
1070    Thread names are short strings meaningful to the user. They do not
1071  Thread names are be single-line strings and are meaningful to the  have to be unique."
 user. They do not have to be unique."  
1072     (declare (ignore thread))     (declare (ignore thread))
1073     "The One True Thread")     "The One True Thread")
1074    
# Line 816  user. They do not have to be unique." Line 1077  user. They do not have to be unique."
1077     (declare (ignore thread))     (declare (ignore thread))
1078     "")     "")
1079    
1080    (definterface thread-attributes (thread)
1081      "Return a plist of implementation-dependent attributes for THREAD"
1082      (declare (ignore thread))
1083      '())
1084    
1085  (definterface make-lock (&key name)  (definterface make-lock (&key name)
1086     "Make a lock for thread synchronization.     "Make a lock for thread synchronization.
1087  Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time."  Only one thread may hold the lock (via CALL-WITH-LOCK-HELD) at a time
1088    but that thread may hold it more than once."
1089     (declare (ignore name))     (declare (ignore name))
1090     :null-lock)     :null-lock)
1091    
# Line 833  Only one thread may hold the lock (via C Line 1100  Only one thread may hold the lock (via C
1100    0)    0)
1101    
1102  (definterface all-threads ()  (definterface all-threads ()
1103    "Return a list of all threads.")    "Return a fresh list of all threads."
1104      '())
1105    
1106  (definterface thread-alive-p (thread)  (definterface thread-alive-p (thread)
1107    "Test if THREAD is termintated."    "Test if THREAD is termintated."
# Line 843  Only one thread may hold the lock (via C Line 1111  Only one thread may hold the lock (via C
1111    "Cause THREAD to execute FN.")    "Cause THREAD to execute FN.")
1112    
1113  (definterface kill-thread (thread)  (definterface kill-thread (thread)
1114    "Kill THREAD."    "Terminate THREAD immediately.
1115    Don't execute unwind-protected sections, don't raise conditions.
1116    (Do not pass go, do not collect $200.)"
1117    (declare (ignore thread))    (declare (ignore thread))
1118    nil)    nil)
1119    
1120  (definterface send (thread object)  (definterface send (thread object)
1121    "Send OBJECT to thread THREAD.")    "Send OBJECT to thread THREAD.")
1122    
1123  (definterface receive ()  (definterface receive (&optional timeout)
1124    "Return the next message from current thread's mailbox.")    "Return the next message from current thread's mailbox."
1125      (receive-if (constantly t) timeout))
1126    
1127    (definterface receive-if (predicate &optional timeout)
1128      "Return the first message satisfiying PREDICATE.")
1129    
1130    (definterface set-default-initial-binding (var form)
1131      "Initialize special variable VAR by default with FORM.
1132    
1133    Some implementations initialize certain variables in each newly
1134    created thread.  This function sets the form which is used to produce
1135    the initial value."
1136      (set var (eval form)))
1137    
1138    ;; List of delayed interrupts.
1139    ;; This should only have thread-local bindings, so no init form.
1140    (defvar *pending-slime-interrupts*)
1141    
1142    (defun check-slime-interrupts ()
1143      "Execute pending interrupts if any.
1144    This should be called periodically in operations which
1145    can take a long time to complete.
1146    Return a boolean indicating whether any interrupts was processed."
1147      (when (and (boundp '*pending-slime-interrupts*)
1148                 *pending-slime-interrupts*)
1149        (funcall (pop *pending-slime-interrupts*))
1150        t))
1151    
1152    (defvar *interrupt-queued-handler* nil
1153      "Function to call on queued interrupts.
1154    Interrupts get queued when an interrupt occurs while interrupt
1155    handling is disabled.
1156    
1157    Backends can use this function to abort slow operations.")
1158    
1159    (definterface wait-for-input (streams &optional timeout)
1160      "Wait for input on a list of streams.  Return those that are ready.
1161    STREAMS is a list of streams
1162    TIMEOUT nil, t, or real number. If TIMEOUT is t, return
1163    those streams which are ready immediately, without waiting.
1164    If TIMEOUT is a number and no streams is ready after TIMEOUT seconds,
1165    return nil.
1166    
1167    Return :interrupt if an interrupt occurs while waiting."
1168      (assert (member timeout '(nil t)))
1169      (cond #+(or)
1170            ((null (cdr streams))
1171             (wait-for-one-stream (car streams) timeout))
1172            (t
1173             (wait-for-streams streams timeout))))
1174    
1175    (defun wait-for-streams (streams timeout)
1176      (loop
1177       (when (check-slime-interrupts) (return :interrupt))
1178       (let ((ready (remove-if-not #'stream-readable-p streams)))
1179         (when ready (return ready)))
1180       (when timeout (return nil))
1181       (sleep 0.1)))
1182    
1183    ;; Note: Usually we can't interrupt PEEK-CHAR cleanly.
1184    (defun wait-for-one-stream (stream timeout)
1185      (ecase timeout
1186        ((nil)
1187         (cond ((check-slime-interrupts) :interrupt)
1188               (t (peek-char nil stream nil nil)
1189                  (list stream))))
1190        ((t)
1191         (let ((c (read-char-no-hang stream nil nil)))
1192           (cond (c
1193                  (unread-char c stream)
1194                  (list stream))
1195                 (t '()))))))
1196    
1197    (defun stream-readable-p (stream)
1198      (let ((c (read-char-no-hang stream nil :eof)))
1199        (cond ((not c) nil)
1200              ((eq c :eof) t)
1201              (t (unread-char c stream) t))))
1202    
1203  (definterface toggle-trace (spec)  (definterface toggle-trace (spec)
1204    "Toggle tracing of the function(s) given with SPEC.    "Toggle tracing of the function(s) given with SPEC.
# Line 873  SPEC can be: Line 1220  SPEC can be:
1220  (definterface make-weak-value-hash-table (&rest args)  (definterface make-weak-value-hash-table (&rest args)
1221    "Like MAKE-HASH-TABLE, but weak w.r.t. the values."    "Like MAKE-HASH-TABLE, but weak w.r.t. the values."
1222    (apply #'make-hash-table args))    (apply #'make-hash-table args))
1223    
1224    (definterface hash-table-weakness (hashtable)
1225      "Return nil or one of :key :value :key-or-value :key-and-value"
1226      (declare (ignore hashtable))
1227      nil)
1228    
1229    
1230    ;;;; Character names
1231    
1232    (definterface character-completion-set (prefix matchp)
1233      "Return a list of names of characters that match PREFIX."
1234      ;; Handle the standard and semi-standard characters.
1235      (loop for name in '("Newline" "Space" "Tab" "Page" "Rubout"
1236                          "Linefeed" "Return" "Backspace")
1237         when (funcall matchp prefix name)
1238         collect name))
1239    
1240    
1241    (defparameter *type-specifier-arglists*
1242      '((and                . (&rest type-specifiers))
1243        (array              . (&optional element-type dimension-spec))
1244        (base-string        . (&optional size))
1245        (bit-vector         . (&optional size))
1246        (complex            . (&optional type-specifier))
1247        (cons               . (&optional car-typespec cdr-typespec))
1248        (double-float       . (&optional lower-limit upper-limit))
1249        (eql                . (object))
1250        (float              . (&optional lower-limit upper-limit))
1251        (function           . (&optional arg-typespec value-typespec))
1252        (integer            . (&optional lower-limit upper-limit))
1253        (long-float         . (&optional lower-limit upper-limit))
1254        (member             . (&rest eql-objects))
1255        (mod                . (n))
1256        (not                . (type-specifier))
1257        (or                 . (&rest type-specifiers))
1258        (rational           . (&optional lower-limit upper-limit))
1259        (real               . (&optional lower-limit upper-limit))
1260        (satisfies          . (predicate-symbol))
1261        (short-float        . (&optional lower-limit upper-limit))
1262        (signed-byte        . (&optional size))
1263        (simple-array       . (&optional element-type dimension-spec))
1264        (simple-base-string . (&optional size))
1265        (simple-bit-vector  . (&optional size))
1266        (simple-string      . (&optional size))
1267        (single-float       . (&optional lower-limit upper-limit))
1268        (simple-vector      . (&optional size))
1269        (string             . (&optional size))
1270        (unsigned-byte      . (&optional size))
1271        (values             . (&rest typespecs))
1272        (vector             . (&optional element-type size))
1273        ))
1274    
1275    ;;; Heap dumps
1276    
1277    (definterface save-image (filename &optional restart-function)
1278      "Save a heap image to the file FILENAME.
1279    RESTART-FUNCTION, if non-nil, should be called when the image is loaded.")
1280    
1281    
1282    

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

  ViewVC Help
Powered by ViewVC 1.1.5