src/standard-descriptions/clos.lisp

   1 (in-package :lisp-on-lines)
   2
   3 (define-description standard-object ()
   4   ((class-slots :label "Slots"
   5                 :function (compose 'class-slots 'class-of))))
   6
   7 (define-layered-class slot-definition-attribute (standard-attribute)
   8  ((slot-name :initarg :slot-name :accessor attribute-slot-name)))
   9
  10 (define-layered-method attribute-value (object (attribute slot-definition-attribute))
  11   (if (slot-boundp object (attribute-slot-name attribute))
  12
  13       (slot-value object (attribute-slot-name attribute))
  14       (gensym "UNBOUND-SLOT-")))
  15
  16 (defmacro define-description-for-class (class-name &optional (name (intern (format nil "DESCRIPTION-FOR-~A" class-name))))
  17   `(progn
  18      (define-description ,name (standard-object)
  19        ,(loop :for slot in (class-slots (find-class class-name))
  20           :collect `(,(slot-definition-name slot)
  21                     :attribute-class slot-definition-attribute
  22                     :slot-name ,(slot-definition-name slot)
  23                     :label ,(slot-definition-name slot)))
  24        (:mixinp t))
  25      (unless (ignore-errors (find-description ',class-name))
  26        (define-description ,class-name (,name) ()))))
  27
  28
  29
  30 (define-layered-method description-of ((object standard-object))
  31   (or (ignore-errors (find-description (class-name (class-of object))))
  32       (find-description 'standard-object)))
  33
  34
  35
  36