;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: :Kr -*-
 ;;*******************************************************************;;
 ;;          The Garnet User Interface Development Environment.       ;;
 ;;*******************************************************************;;
 ;;  This code was written by Russell Almond at Statistical Sciences  ;;
 ;;  as an independent contribution to the Garnet project at          ;;
 ;;  Carnegie Mellon University, and has been placed in the public    ;;
 ;;  domain.                                                          ;;
 ;;                                                                   ;;
 ;;  The authors of the code make no warentee expressed or implied    ;;
 ;;  about its utility, rather we hope that someone may find a use    ;;
 ;;  for it.                                                          ;;
 ;;*******************************************************************;;
 
 ;;; $Id$
 ;;
 
 
 ;;; This package introduces a documentation convention for KR objects
 ;;  and provides some simple functions to read that documentation.
 ;;
 ;; The first half of the convention is easy.  Each schema can have a
 ;; slot called :documentation which contains information for the
 ;; programmer about the schema.
 
 ;; The second half of the convention provides information about
 ;; slots.  This is done through the :slot-doc slot of the schema.
 ;; This is a paired list of the form slot-name, doc-string.
 
 ;; The function kr:get-slot-doc (<schema> <slot>) accesses the
 ;; doc-string for a schema. It will search first the local slot and
 ;; then back through the inheritence chain to find the documentation
 ;; for a slot.  The function kr:set-slot-doc  (<schema> <slot>
 ;; <value>) will set the documentation associated with the slot.
 
 ;; In order to prevent documentation strings from adding volume to
 ;; images where they are not wanted, I've added a feature switch
 ;; kr-doc.  This should be used to protect documentation when it is
 ;; not wanted (i.e., when this file has not been loaded first.)
 ;; Example:
 ;;  (kr:create-instance 'verbose-rectangle opal:rectangle
 ;;    #+kr-doc (:documentation "Opal:rectangle with documentation strings.")
 ;;    #+kr-doc (:slot-doc :left "Horizontal Co-ordinate for Rectangle."
 ;;		          :top "Vertical Co-ordinate for Rectangle."
 ;;		          :height "Vertical Extent of Rectangle."
 ;;		          :width "Horizontal Extent of Rectangle."
 ;;		          :line-style "The color, width and dashing of the border."
 ;;		          :filling-style "The color and shading of the interior."
 ;;		          :draw-function "How does drawing interact with
 ;;                                        objects underneath."
 ;;		          :visible "Is the object to be drawn?"))
 
 
 ;;; KR part of garnet must be loaded.
 (in-package :kr)
 
 
 
 (defun get-slot-doc (schema slot)
   "Returns the documentation string associated with <slot> in <schema>."
   (declare (type (or Schema List) schema)
 	   (type (or Keyword Symbol) slot))
   (cond ((null schema) nil)
 	((consp schema)
 	 (let ((doc-string (get-slot-doc (car schema) slot)))
 	   (declare (type (or String Null) doc-string))
 	   (if (equal nil doc-string)
 	       (get-slot-doc (cdr schema) slot)
 	     doc-string)))
 	((schema-p schema)
 	 (let ((doc-string (getf (get-local-value schema :slot-doc) slot)))
 	   (if (stringp doc-string) doc-string
 	     (get-slot-doc (get-local-value schema :is-a) slot))))
 	(t (error "~S is not a schema or list of schemas."
 		  schema))))
 
 
 (defun set-slot-doc (schema slot doc-string)
   "Sets the documentation string associated with <slot> in <schema>."
   (declare (type Schema  schema)
 	   (type (or Keyword Symbol) slot)
 	   (type String doc-string))
   (let ((doc-plist (get-local-value schema :slot-doc)))
     (setf (getf doc-plist slot) doc-string)
     (s-value schema :slot-doc  doc-plist)))
 
 (pushnew :KR-DOC *Features*)