Changeset 10291


Ignore:
Timestamp:
10/31/05 04:00:46 (16 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/j/src/org/armedbear/lisp/describe.lisp

    r10215 r10291  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: describe.lisp,v 1.6 2005-10-24 21:12:58 piso Exp $
     4;;; $Id: describe.lisp,v 1.7 2005-10-31 04:00:46 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    9292(defmethod describe-object ((object pathname) stream)
    9393  (format stream "~S is an object of type ~S:~%" object (type-of object))
    94   (format stream " HOST         ~S~%" (pathname-host object))
    95   (format stream " DEVICE       ~S~%" (pathname-device object))
    96   (format stream " DIRECTORY    ~S~%" (pathname-directory object))
    97   (format stream " NAME         ~S~%" (pathname-name object))
    98   (format stream " TYPE         ~S~%" (pathname-type object))
    99   (format stream " VERSION      ~S~%" (pathname-version object)))
     94  (format stream "  HOST         ~S~%" (pathname-host object))
     95  (format stream "  DEVICE       ~S~%" (pathname-device object))
     96  (format stream "  DIRECTORY    ~S~%" (pathname-directory object))
     97  (format stream "  NAME         ~S~%" (pathname-name object))
     98  (format stream "  TYPE         ~S~%" (pathname-type object))
     99  (format stream "  VERSION      ~S~%" (pathname-version object)))
     100
     101(defun slot-value-or-default (object slot-name)
     102  (if (slot-boundp object slot-name)
     103      (slot-value object slot-name)
     104      +slot-unbound+))
    100105
    101106(defmethod describe-object ((object standard-object) stream)
    102   (%describe-object object stream)
    103   (values))
     107  (let* ((class (class-of object))
     108         (slotds (class-slots class))
     109         (max-slot-name-length 0)
     110         (instance-slotds ())
     111         (class-slotds ()))
     112    (format stream "~S is an instance of ~S.~%" object class)
     113    (dolist (slotd slotds)
     114      (let* ((name (%slot-definition-name slotd))
     115             (length (length (symbol-name name))))
     116        (when (> length max-slot-name-length)
     117          (setf max-slot-name-length length)))
     118      (case (%slot-definition-allocation slotd)
     119        (:instance (push slotd instance-slotds))
     120        (:class  (push slotd class-slotds))))
     121    (setf max-slot-name-length  (min (+ max-slot-name-length 3) 30))
     122    (flet ((describe-slot (name value)
     123             (format stream
     124                     "~&  ~A~VT  ~S"
     125                     name max-slot-name-length value)))
     126      (when instance-slotds
     127        (format stream "The following slots have :INSTANCE allocation:~%")
     128        (dolist (slotd (nreverse instance-slotds))
     129          (describe-slot
     130           (%slot-definition-name slotd)
     131           (slot-value-or-default object (%slot-definition-name slotd)))))
     132      (when class-slotds
     133        (format stream "The following slots have :CLASS allocation:~%")
     134        (dolist (slotd (nreverse class-slotds))
     135          (describe-slot
     136           (%slot-definition-name slotd)
     137           (slot-value-or-default object (%slot-definition-name slotd)))))))
     138    (values))
    104139
    105140(defmethod describe-object ((object java:java-object) stream)
Note: See TracChangeset for help on using the changeset viewer.