(FILECREATED " 1-Oct-86 21:04:00" {ERIS}<LISPCORE>SOURCES>CMLDOC.;4
 4269   

      changes to:  (VARS CMLDOCCOMS)

      previous date: " 1-Oct-86 17:52:43" {ERIS}<LISPCORE>SOURCES>CMLDOC.;3)


(* "
Copyright (c) 1986 by Xerox Corporation.  All rights reserved.
")

(PRETTYCOMPRINT CMLDOCCOMS)

(RPAQQ CMLDOCCOMS
 ((* ;;; "Documentation strings")
                   (VARIABLES *DOCUMENTATION-HASH-TABLE*)
                   (FUNCTIONS DOCUMENTATION HASH-TABLE-FOR-DOC-TYPE SET-DOCUMENTATION)
                   (SETFS DOCUMENTATION)
                   (* 
                     "Should be in CMLEXEC because exec command definer is loaded long after CMLDOC."
                      (COMMANDS DOC))
                   (* ;; "Use the proper compiler")
                   (PROP FILETYPE CMLDOC)))



(* ;;; "Documentation strings")


(DEFGLOBALVAR *DOCUMENTATION-HASH-TABLE*
 (* ;;; "This is the repository for all documentation strings in the system.  It is a two-level hash-table scheme, just like *definition-hash-table*.  At the first level, *DOCUMENTATION-HASH-TABLE* maps the symbols that name documentation-types into a separate hash table for each type.  Those tables map names into the documentation strings for those names.  The first-level table uses an EQ test while the second-level ones use CL:EQUAL."
                                            ) 
    (* ;; "The hash-table is initialized to have second-level tables for each of the required documentation types.")

   (LET ((HT (MAKE-HASH-TABLE :TEST (QUOTE EQ
)
                    :SIZE 10 :REHASH-SIZE 5)))
        (FOR TYPE IN (QUOTE (TYPE SETF STRUCTURE CL:FUNCTION VARIABLE))
             DO
             (SETF (GETHASH TYPE HT)
                   (MAKE-HASH-TABLE :TEST (QUOTE CL:EQUAL)
                          :SIZE 50 :REHASH-SIZE 50)))
        HT))

(DEFUN DOCUMENTATION
 (NAME DOC-TYPE) (GETHASH NAME (HASH-TABLE-FOR-DOC-TYPE DOC-TYPE)))

(DEFUN HASH-TABLE-FOR-DOC-TYPE
 (DOC-TYPE) (LET ((HT (GETHASH DOC-TYPE *DOCUMENTATION-HASH-TABLE*)))
                                               (CL:WHEN (NULL HT)
                                                      (WARN 
                                             "The documentation type %"~S%" was not previously known" 
                                                            DOC-TYPE)
                                                      (SETQ HT (SETF (GETHASH DOC-TYPE 
                                                                           *DOCUMENTATION-HASH-TABLE*
                                                                            )
                                                                     (MAKE-HASH-TABLE :TEST
                                                                            (QUOTE CL:EQUAL)
                                                                            :SIZE 50 :REHASH-SIZE 50)
                                                                     )))
                                               HT))

(DEFUN SET-DOCUMENTATION
 (NAME DOC-TYPE NEW-STRING) (SETF (GETHASH NAME (HASH-TABLE-FOR-DOC-TYPE
                                                                         DOC-TYPE))
                                                          NEW-STRING))

(DEFSETF DOCUMENTATION
 (NAME DOC-TYPE) (NEW-STRING)

                                                  (* ;; "The WHEN is to allow this to be used in code that comes earlier in the loadup than CMLDOC.  Such code won't have its strings saved, but it won't blow up, either.")

                                       (BQUOTE (PROGN (CL:WHEN (FBOUNDP (QUOTE SET-DOCUMENTATION))
                                                             (SET-DOCUMENTATION (\, NAME)
                                                                    (\, DOC-TYPE)
                                                                    (\, NEW-STRING)))
                                                      (\, NEW-STRING))))




(* "Should be in CMLEXEC because exec command definer is loaded long after CMLDOC." (COMMANDS 
DOC))





(* ;; "Use the proper compiler")



(PUTPROPS CMLDOC FILETYPE
 COMPILE-FILE)
(PUTPROPS CMLDOC COPYRIGHT ("Xerox Corporation" 1986))
(DECLARE: DONTCOPY
  (FILEMAP (NIL)))
STOP