src/description.lisp

   1 (in-package :lisp-on-lines)
   2
   3 (define-description description ())
   4
   5 (defgeneric find-description-class (name &optional errorp)
   6   (:method ((name (eql t)) &optional errorp)
   7     (declare (ignore errorp))
   8     (find-class 'description t))
   9   (:method ((name symbol) &optional errorp)
  10     (or (find-class (defining-description name) errorp)
  11         (find-description-class t)))
  12   (:method ((description description) &optional errorp)
  13     (declare (ignore errorp))
  14     (class-of description)))
  15
  16 (defun find-description (name)
  17    (slot-value (find-description-class name) 'instance))
  18
  19 (defun description-attributes (description)
  20   (closer-mop:class-slots (find-description-class description)))
  21
  22 (define-layered-function attributes (description))
  23
  24 (define-layered-method attributes (description)
  25  (description-attributes description))
  26
  27 ;;;!-- TODO: This is a prime candidate for optimization
  28 (defun find-attribute (description attribute-name)
  29   (find attribute-name (description-attributes description) :key #'attribute-name))
  30
  31 (define-display ((description description))
  32   (format *display* "~{~A~%~}"
  33           (mapcar
  34            (lambda (attribute)
  35              (with-output-to-string (*display*)
  36                (display-attribute attribute)))
  37            (attributes description))))
  38
  39 (define-layered-method description-of (object)
  40   (find-description 't))
  41
  42 (define-layered-method description-of ((symbol symbol))
  43   (find-description 'symbol))
  44
  45 (define-description symbol ()
  46   ((identity :label "Symbol:")
  47    (name
  48     :function #'symbol-name
  49     :label "Name:")
  50    (value
  51     :label "Value:"
  52     :function
  53     (lambda (symbol)
  54       (if (boundp symbol)
  55           (symbol-value symbol)
  56           "<UNBOUND>")))
  57    (package :function #'symbol-package
  58             :label "Package:")
  59    (function :label "Function:"
  60     :function
  61     (lambda (symbol)
  62      (if (fboundp symbol)
  63          (symbol-function symbol)
  64          "<UNBOUND>")))))
  65
  66
  67
  68
  69
  70
  71
  72
  73
  74
  75