
Return-Path: <almond%statsci.com@relay1.UU.NET>
Received: from EDRC.CMU.EDU by A.GP.CS.CMU.EDU id ad27425; 15 Sep 93 1:12:24 EDT
Received: from relay1.UU.NET by EDRC.CMU.EDU id aa24812; 15 Sep 93 1:11:18 EDT
Received: from spool.uu.net (via LOCALHOST) by relay1.UU.NET with SMTP 
	(5.61/UUNET-internet-primary) id AA10712; Wed, 15 Sep 93 01:11:11 -0400
Received: from statsci.UUCP by uucp3.uu.net with UUCP/RMAIL
	(queueing-rmail) id 010932.3480; Wed, 15 Sep 1993 01:09:32 EDT
Received: from herb.statsci.com by statsci.com (4.1/SMI-3.2 ssi v3.42)
	id AA09339; Tue, 14 Sep 93 21:13:48 PDT
Received: by herb.statsci.com (4.1/SMI-4.1)
	id AA06286; Tue, 14 Sep 93 21:13:05 PDT
Date: Tue, 14 Sep 93 21:13:05 PDT
From: almond@statsci.com (Russell G. Almond)
Message-Id: <9309150413.AA06286@herb.statsci.com>
To: garnet@cs.cmu.edu
Subject: A new structure documentation feature for KR
Status: R


I've written the following file for adding documentation and slot
documentation to KR object.  Because this can take up extra room, by
convention I've added a kr-doc feature.  Thus all the documentation
can be commented out with #+kr-doc and it won't be loaded unless the
user specifically requests it.

;;; -*- 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.  If you are using this code or any part of Garnet,      ;;;
;;; please contact garnet@cs.cmu.edu to be put on the mailing list. ;;;
;;;                                                                 ;;;
;;; 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.                                                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; 8/19/93 RGA Extensions to KR to support Facets.
;;;=======================================================

;;; KR part of garnet must be loaded.
(in-package :Kr)

;;; 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?"))


(export '(get-slot-doc set-slot-doc))


(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)
	   #+cmu(returns (type (or String Null))))
  (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*)

	
	 
  
  
