Changeset 10297


Ignore:
Timestamp:
10/31/05 12:26:09 (16 years ago)
Author:
piso
Message:

Work in progress.

File:
1 edited

Legend:

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

    r10291 r10297  
    22;;;
    33;;; Copyright (C) 2005 Peter Graves
    4 ;;; $Id: describe.lisp,v 1.7 2005-10-31 04:00:46 piso Exp $
     4;;; $Id: describe.lisp,v 1.8 2005-10-31 12:26:09 piso Exp $
    55;;;
    66;;; This program is free software; you can redistribute it and/or
     
    9999  (format stream "  VERSION      ~S~%" (pathname-version object)))
    100100
    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+))
    105 
    106101(defmethod describe-object ((object standard-object) stream)
    107102  (let* ((class (class-of object))
     
    120115        (:class  (push slotd class-slotds))))
    121116    (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)))
     117    (flet ((describe-slot (slot-name)
     118             (if (slot-boundp object slot-name)
     119                 (format stream
     120                         "~&  ~A~VT  ~S"
     121                         slot-name max-slot-name-length (slot-value object slot-name))
     122                 (format stream
     123                         "~&  ~A~VT  unbound"
     124                         slot-name max-slot-name-length))))
    126125      (when instance-slotds
    127126        (format stream "The following slots have :INSTANCE allocation:~%")
    128127        (dolist (slotd (nreverse instance-slotds))
    129128          (describe-slot
    130            (%slot-definition-name slotd)
    131            (slot-value-or-default object (%slot-definition-name slotd)))))
     129           (%slot-definition-name slotd))))
    132130      (when class-slotds
    133131        (format stream "The following slots have :CLASS allocation:~%")
    134132        (dolist (slotd (nreverse class-slotds))
    135133          (describe-slot
    136            (%slot-definition-name slotd)
    137            (slot-value-or-default object (%slot-definition-name slotd)))))))
     134           (%slot-definition-name slotd))))))
    138135    (values))
    139136
Note: See TracChangeset for help on using the changeset viewer.