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

Diff of /slime/swank-abcl.lisp

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

revision 1.16 by asimon, Tue Sep 14 22:42:52 2004 UTC revision 1.17 by asimon, Mon Sep 20 13:30:30 2004 UTC
# Line 14  Line 14 
14  (eval-when (:compile-toplevel :load-toplevel :execute)  (eval-when (:compile-toplevel :load-toplevel :execute)
15    (require :collect) ;just so that it doesn't spoil the flying letters    (require :collect) ;just so that it doesn't spoil the flying letters
16    (require :gray-streams)    (require :gray-streams)
17    (require :pprint)    (require :pprint))
18    )  
19    
20  (import  (import
21   '(gs:fundamental-character-output-stream   '(gs:fundamental-character-output-stream
# Line 42  Line 42 
42  (defun slot-definition-type (slot) t)  (defun slot-definition-type (slot) t)
43  (defun class-prototype (class))  (defun class-prototype (class))
44  (defun generic-function-declarations (gf))  (defun generic-function-declarations (gf))
45    (defun specializer-direct-methods (spec) nil)
46    
47  (import-to-swank-mop  (import-to-swank-mop
48   '( ;; classes   '( ;; classes
# Line 55  Line 56 
56     sys::class-direct-slots     sys::class-direct-slots
57     sys::class-direct-subclasses     sys::class-direct-subclasses
58     sys::class-direct-superclasses     sys::class-direct-superclasses
59       sys::eql-specializer
60     class-finalized-p ;;dummy     class-finalized-p ;;dummy
61     cl:class-name     cl:class-name
62     sys::class-precedence-list     sys::class-precedence-list
63     class-prototype ;;dummy     class-prototype ;;dummy
64     sys::class-slots     sys::class-slots
65       specializer-direct-methods ;;dummy
66       ;; eql-specializer accessors
67       sys::eql-specializer-object
68     ;; generic function readers     ;; generic function readers
69     sys::generic-function-argument-precedence-order     sys::generic-function-argument-precedence-order
70     generic-function-declarations ;;dummy     generic-function-declarations ;;dummy
# Line 132  Line 137 
137  ;;;; Misc  ;;;; Misc
138    
139    
140  (defimplementation arglist ((symbol symbol))  (defimplementation arglist ((symbol t))
141    (handler-case (sys::arglist symbol)    (multiple-value-bind (arglist present)
142      (simple-error () :not-available)))        (sys::arglist symbol)
143        (if present arglist :not-available)))
144    
145    
 ;;It's a string, not a symbol, but this is better than nothing.  
146  (defimplementation function-name (function)  (defimplementation function-name (function)
147    (nth-value 2 (function-lambda-expression function)))    (nth-value 2 (function-lambda-expression function)))
148    
# Line 323  Line 329 
329  (defimplementation find-definitions (symbol)  (defimplementation find-definitions (symbol)
330    (source-location symbol))    (source-location symbol))
331    
332    #|
333    Uncomment this if you have patched xref.lisp, as in
334    http://article.gmane.org/gmane.lisp.slime.devel/2425
335    Also, make sure that xref.lisp is loaded by modifying the armedbear
336    part of *sysdep-pathnames* in swank.loader.lisp.
337    
 #|  
 Should work (with a patched xref.lisp) but is it any use without find-definitions?  
338  ;;;; XREF  ;;;; XREF
339  (setq pxref::*handle-package-forms* '(cl:in-package))  (setq pxref:*handle-package-forms* '(cl:in-package))
340    
341  (defmacro defxref (name function)  (defmacro defxref (name function)
342    `(defimplementation ,name (name)    `(defimplementation ,name (name)
# Line 343  Should work (with a patched xref.lisp) b Line 352  Should work (with a patched xref.lisp) b
352  (defun xref-results (symbols)  (defun xref-results (symbols)
353    (let ((xrefs '()))    (let ((xrefs '()))
354      (dolist (symbol symbols)      (dolist (symbol symbols)
355        (push (list symbol (fspec-location symbol)) xrefs))        (push (list symbol (cadar (source-location symbol))) xrefs))
356      xrefs))      xrefs))
   
357  |#  |#
358    
359  ;;;; Inspecting  ;;;; Inspecting
# Line 375  Should work (with a patched xref.lisp) b Line 383  Should work (with a patched xref.lisp) b
383  (defmethod inspect-for-emacs ((f function) (inspector abcl-inspector))  (defmethod inspect-for-emacs ((f function) (inspector abcl-inspector))
384    (declare (ignore inspector))    (declare (ignore inspector))
385    (values "A function."    (values "A function."
386            `("Name: " (:value ,(function-name f)) (:newline)            `(,@(when (function-name f)
387              "Argument list: " ,(princ-to-string (sys::arglist f))                      `("Name: "
388                          ,(princ-to-string (function-name f)) (:newline)))
389                ,@(multiple-value-bind (args present)
390                                       (sys::arglist f)
391                                       (when present `("Argument list: " ,(princ-to-string args) (:newline))))
392              (:newline)              (:newline)
393              #+nil,@(when (documentation f t)              #+nil,@(when (documentation f t)
394                           `("Documentation:" (:newline) ,(documentation f t) (:newline)))                           `("Documentation:" (:newline) ,(documentation f t) (:newline)))
395              ,@(when (function-lambda-expression f)              ,@(when (function-lambda-expression f)
396                      `("Lambda expression:"                      `("Lambda expression:"
397                        (:newline) ,(prin1-to-string (function-lambda-expression f)) (:newline))))))                        (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline))))))
398    
399  #|  #|
400    

Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17

  ViewVC Help
Powered by ViewVC 1.1.5