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

Diff of /slime/swank-allegro.lisp

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

revision 1.55 by mbaringer, Tue Sep 14 07:48:50 2004 UTC revision 1.56 by mbaringer, Tue Sep 14 16:01:07 2004 UTC
# Line 409  Line 409 
409    
410  ;;;; Inspecting  ;;;; Inspecting
411    
412  (defmethod inspected-parts (o)  (defclass acl-inspector (inspector)
413    (let* ((class (class-of o))    ())
414           (slots (clos:class-slots class)))  
415      (values (format nil "~A~%   is a ~A" o class)  (defimplementation make-default-inspector ()
416              (mapcar (lambda (slot)    (make-instance 'acl-inspector))
417                        (let ((name (clos:slot-definition-name slot)))  
418                          (cons (princ-to-string name)  (defimplementation inspect-for-emacs ((o t) (inspector acl-inspector))
419                                (if (slot-boundp o name)    (declare (ignore inspector))
420                                    (slot-value o name)    (values "A value."
421                                    (make-unbound-slot-filler)))))            `("Type: " (:value ,(class-of o))
422                      slots))))              (:newline)
423                "Slots:" (:newline)
424                ,@(loop
425                     for slot in (clos:class-slots class)
426                     for name = (clos:slot-definition-name slot)
427                     collect `(:value ,name)
428                     collect " = "
429                     collect (if (slot-boundp o name)
430                                 `(:value ,(slot-value o name))
431                                 "#<unbound>")))))
432    
433  ;; duplicated from swank.lisp in order to avoid package dependencies  ;; duplicated from swank.lisp in order to avoid package dependencies
434  (defun common-seperated-spec (list &optional (callback (lambda (v) `(:value ,v))))  (defun common-seperated-spec (list &optional (callback (lambda (v) `(:value ,v))))
# Line 429  Line 438 
438        collect (funcall callback i)        collect (funcall callback i)
439        collect ", ")))        collect ", ")))
440    
441  ;; AllegroCL doesn't support (documentation <function-obj> t)  (defmethod inspect-for-emacs ((f function) (inspector acl-inspector))
442  ;; so we get the symbol and then its doc    (declare (ignore inspector))
443  (defun function-documentation (obj)    (values "A function."
   (documentation (excl::external-fn_symdef obj) 'function))  
   
 (defmethod inspected-parts ((f function))  
   (values (format nil "The function ~S." f)  
444            `("Name: " (:value ,(function-name f)) (:newline)            `("Name: " (:value ,(function-name f)) (:newline)
445              "It's argument list is: " ,(princ-to-string (arglist f)) (:newline)              "It's argument list is: " ,(princ-to-string (arglist f)) (:newline)
446              "Documentation:" (:newline)              "Documentation:" (:newline)
447              ,(function-documentation f))))              ;; AllegroCL doesn't support (documentation <function-obj> t)
448                ;; so we get the symbol and then its doc
449                ,(documentation (excl::external-fn_symdef obj) 'function))))
450    
451  (defmethod inspected-parts ((class structure-class))  (defmethod inspect-for-emacs ((class structure-class) (inspector acl-inspector))
452      (declare (ignore inspector))
453    (values "A structure class."    (values "A structure class."
454            `("Name: " (:value ,(class-name class))            `("Name: " (:value ,(class-name class))
455              (:newline)              (:newline)
# Line 476  Line 484 
484                                 `(:value ,(swank-mop:class-prototype class))                                 `(:value ,(swank-mop:class-prototype class))
485                                 '"N/A (class not finalized)"))))                                 '"N/A (class not finalized)"))))
486    
487  (defmethod inspected-parts ((slot excl::structure-slot-definition))  (defmethod inspect-for-emacs ((slot excl::structure-slot-definition) (inspector acl-inspector))
488      (declare (ignore inspector))
489    (values "A structure slot."    (values "A structure slot."
490            `("Name: " (:value ,(mop:slot-definition-name slot))            `("Name: " (:value ,(mop:slot-definition-name slot))
491              (:newline)              (:newline)
# Line 492  Line 501 
501              "Allocation: " (:value ,(excl::slotd-allocation slot)) (:newline)              "Allocation: " (:value ,(excl::slotd-allocation slot)) (:newline)
502              "Read-only: " (:value ,(excl::slotd-read-only slot)) (:newline))))              "Read-only: " (:value ,(excl::slotd-read-only slot)) (:newline))))
503    
504  (defmethod inspected-parts ((o structure-object))  (defmethod inspect-for-emacs ((o structure-object) (inspector acl-inspector))
505      (declare (ignore inspector))
506    (values "An structure object."    (values "An structure object."
507            `("Structure class: " (:value ,(class-of o))            `("Structure class: " (:value ,(class-of o))
508              (:newline)              (:newline)

Legend:
Removed from v.1.55  
changed lines
  Added in v.1.56

  ViewVC Help
Powered by ViewVC 1.1.5