ContextL documentation methods for Layered Classes

contextl-documentation-method.lisp

;; DOCUMENTATION
;; With  the following  method definitions  on generic  function DOCUMENTATION,
;; "documentation (x symbol)  (doc-type (eql 'type))" form  works flawlessly in
;; CCL, ECL and CLISP  while it doesn't work on SBCL and  CMUCL because they do
;; not implement documentation  methods that specialize on symbols  in terms of
;; their   class  counterparts.   Nothing  to   do  about   it  except   fixing
;; implementations.

(defmethod documentation ((x contextl:layered-class) (doc-type (eql 't)))
  (documentation
   (getf (contextl:partial-class-defining-classes x) 't)
   'type))

(defmethod documentation ((x contextl:layered-class) (doc-type (eql 'type)))
  (documentation x 't))

(defmethod (setf documentation) (new-value
                                 (x contextl:layered-class)
                                 (doc-type (eql 't)))
  (setf (documentation
         (getf (contextl:partial-class-defining-classes x) 't)
         't) new-value))

(defmethod (setf documentation) (new-value
                                 (x contextl:layered-class)
                                 (doc-type (eql 'type)))
  (setf (documentation x 't) new-value))

;; DOCUMENTATION*
;; A more complete documentation of  the thing, taking metaclass related issues
;; into account. Tailored with layered-class and similar scenarios in mind.

(defgeneric documentation* (x doc-type)
  (:documentation "A more complete documentation of the thing, taking metaclass
  related issues into account."))

(defmethod documentation* (x doc-type)
  (documentation x doc-type))

(defmethod documentation* ((x symbol) (doc-type (eql 'type))
                           &aux (class (find-class x nil)))
  (if class
      (documentation* class 't)
      (call-next-method)))

(defmethod documentation* ((x contextl:layered-class) (doc-type (eql 'type)))
  "Formats  a  string containing  documentation  compiled  from each  LAYERED
  definition of the same CLASS."
  (documentation* x 't))

(defmethod documentation* ((x contextl:layered-class) (doctype (eql 't))
                           &aux docs)
  "Formats  a  string containing  documentation  compiled  from each  LAYERED
  definition of the same CLASS."
  (format nil "~{~a~^~%~}"
          (loop for (layer defining-class)
                  on (contextl:partial-class-defining-classes x)
                by #'cddr
                do (push (format nil "~@[~:@(~a Layer: ~)~]~a"
                                 (if (eql layer t) nil layer)
                                 (documentation defining-class 'type)) docs)
                finally (return docs))))

(defgeneric (setf documentation*) (new-value x doc-type)
  (:documentation "Setter function for DOCUMENTATION*. Signals an ERROR."))

(defmethod (setf documentation*) ((new-value t) (x t) (doc-type t))
  (error "DOCUMENTATION* does not provide setters. Use DOCUMENTATION."))