;;; -*- Mode:Common-Lisp; Package:ZWEI; Base:10; Fonts:(MEDFNT TR12B TR12BI) -*-
;;;
;;;                           RESTRICTED RIGHTS LEGEND

;;;Use, duplication, or disclosure by the Government is subject to
;;;restrictions as set forth in subdivision (c)(1)(ii) of the Rights in
;;;Technical Data and Computer Software clause at 52.227-7013.
;;;
;;;                     TEXAS INSTRUMENTS INCORPORATED.
;;;                              P.O. BOX 2909
;;;                           AUSTIN, TEXAS 78769
;;;                                 MS 2151
;;;
;;; Copyright (C) 1987-1989 Texas Instruments Incorporated. All rights reserved.

;;;
;;; Client Namespace Code
;;;
;;; Change History started 10/22/87
;;; -------------------------------
;;; 03-13-89  DAB   Fixed visidoc-server-list to work on microExplorer.
;;; ---Release 4.0 and beyond---
;;; 02-21-89   DAB  Fixed VISIDOC-SERVER-LIST to search *defined-products* for the Explorer System Release.
;;;                 LX machine add an addition entry to this list and visidoc was picking up the wrong
;;;                 major version.
;;; 1/19/88    slm  Add stuff to symbol-plist of *doc-namespace* about release info
;;;                 of the booted load band.  Necessary to contact servers for Visidoc
;;;                 information starting in Release 4.0


(DEFFLAVOR ONLINE-DOCUMENT-NAMESPACE NIL (NAME::BASIC-NAMESPACE)
   (:DEFAULT-INIT-PLIST :USAGE :DOC-CLIENT :DOMAIN-NAME "Doc-Client")
   :SETTABLE-INSTANCE-VARIABLES) 


(DEFMETHOD (ONLINE-DOCUMENT-NAMESPACE :INIT) (PLIST)
  "Set up the namespace instance"
  (SEND SELF :MAKE-NAMESPACE-HASH-TABLE)
  (SEND SELF :INTERNAL-ADD-OBJECT
     (NAME::BUILD-OBJECT NAME::DOMAIN-NAME :NAMESPACE
			 (LIST :TYPE :PUBLIC :USAGE (GET PLIST :USAGE))))) 


(DEFVAR *DOC-NAMESPACE* (MAKE-INSTANCE 'ONLINE-DOCUMENT-NAMESPACE))


(DEFUN VISIDOC-SERVER-LIST NIL
  (LET ((prod (dolist (item sys:*DEFINED-PRODUCTS*) ; DAB 02-21-89 The car is not the Explorer Release on LX.
		(when (or (string-equal (send item :name) "Explorer System Release")
			  (string-equal (send item :name) "microExplorer System Release")) ; DAB 03-13-89
		  (return item)))))
    (CADR (ASSOC (OR (GETF (SYMBOL-PLIST '*doc-namespace*) :version)
		     (PROGN
		       (EVAL
			 `(DEFPROP *doc-namespace* 
				   ,(READ-FROM-STRING (FORMAT nil ":REL-~s-~s"
							      (SEND prod :major-version)
							      (SEND prod :minor-version))) :version))
		       (GETF (SYMBOL-PLIST '*doc-namespace*) :version)))
	    (GET-SITE-OPTION :VISIDOC-SERVERS nil)))
    ))


(DEFUN ENTRIES-ALIST (NAME MANUAL)
  "Returns a list of the form '((type info) (type info) ...) for NAME in MANUAL. It is not quite an a-list
because the car's of the lists can be duplicated."
  (LET* ((OBJECT
	  (OR (NAME::LOOKUP-OBJECT NAME MANUAL :NAMESPACE *DOC-NAMESPACE* :LOCAL T)
	     (NAME:REMOTE-CALL (VISIDOC-SERVER-LIST)
			       (FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version)) 
			       T T :GET-OBJECT NAME MANUAL))))
    (WHEN OBJECT (ENTRIES-ALIST-INTERNAL (NAME::GET-ATTRIBUTE-LIST OBJECT)))))


(DEFUN ENTRIES-ALIST-INTERNAL (ATTR-LIST &AUX NTH)
  "Converts an attribute list (already in list form) into the '((type info) (type info) ...) format."
  (REMPROP (CONS NIL ATTR-LIST) :NODE)
  (SETQ NTH 0)
  (DO* ((LST ATTR-LIST (CDDR LST))
	(TYPE (FIRST LST) (FIRST LST))
	(ATRS (SECOND LST) (SECOND LST))
	(RET-LIST NIL))
       ((NULL LST)
	RET-LIST)
    (DOLIST (ATR ATRS)
      (PUSH-END (LIST TYPE ATR NTH) RET-LIST)
      (INCF NTH)))) 


(DEFUN NAME::FIND-OBJECT (NAME NS &OPTIONAL (CLASS-LIST NIL))
  "Looks for an object named NAME in namespace NS. If class-list is specified, it is a list of
classes to search through. Otherwise it will search through all classes in NS for this name.
 Returns t2hree* values: OBJECT2,* CLASS2, and MORE-EXIST-P*. If 2OBJECT and CLASS* nil, no object was found.
2If MORE-EXIST-P is true, multiple objects exist within the class-list (*or all the classes if class-list was nil)2.*"
  (LET ((OBJECT NIL)
        (ret-object-list nil))             ;1Save a list to determine whether multiple objects.*
    (IF CLASS-LIST
      (WHEN (SYMBOLP CLASS-LIST)
	(SETQ CLASS-LIST (LIST CLASS-LIST)))
      (SETQ CLASS-LIST (REMOVE :NAMESPACE (NAME::NAMESPACE-CLASSES NS))))
    (LOOP FOR MANUAL IN CLASS-LIST DO
       (WHEN (SETQ OBJECT (NAME::LOOKUP-OBJECT NAME MANUAL :NAMESPACE NS))
	 (PUSH object ret-object-list)))
    (COND ((NULL ret-object-list)
           (VALUES nil nil))
          ((> (LENGTH ret-object-list) 1)
           (VALUES (FIRST ret-object-list) (name:object-class (FIRST ret-object-list)) T))
          (t (VALUES (FIRST ret-object-list) (name:object-class (FIRST ret-object-list)) nil)))))


(DEFUN NAME::FIND-ALL-OBJECTS (NAME NS)
  (LET ((OBJECT NIL)
        (ret-object-list nil)
        (CLASS-LIST (REMOVE :NAMESPACE (NAME::NAMESPACE-CLASSES NS))))
    (LOOP FOR MANUAL IN CLASS-LIST DO
       (WHEN (SETQ OBJECT (NAME::LOOKUP-OBJECT NAME MANUAL :NAMESPACE NS))
	 (PUSH object ret-object-list)))
    RET-OBJECT-LIST))


(DEFUN GET-STUFF-FROM-DOC-SERVER (STUFF &OPTIONAL &KEY MANUAL NTH FORCED-GET)
  "Retrieves the text from the network server for online documentation and returns it. Parameters are:
STUFF = string to retrieve
:MANUAL = manual name from which to retrieve the information (:LISP, :IO, :NETWORK, etc)
:NTH = which item (if there are multiple items)
:FORCED-GET = read the information for STUFF even if there is a node already in the namespace (t)
                    (default is NIL)
Returns one of:
NIL if no item exists with the name STUFF;
Node instance if this item had been read in before and :FORCED-GET is nil;
LIST of object followed by strings and lists if it had not been read in before or :FORCED-GET is non-nil;
LIST of object followed by keyword :MULTIPLE-ATTRIBUTES if we can't determine 
  which of multiple definitions is requested. "
  (LET (OBJECT NODES INDEX more? ignr)
    (SETQ STUFF (STRING-TRIM '(#\SPACE) STUFF))
    (WHEN (AND (SETQ index (STRING-SEARCH-SET '(#\:) stuff))
	       (PLUSP index)
	       (FIND-PACKAGE (READ-FROM-STRING stuff t nil :end index)))
      (SETQ stuff (SUBSEQ stuff (1+ index))))
    (MULTIPLE-VALUE-SETQ (object ignr more?)
      (NAME::FIND-OBJECT STUFF *DOC-NAMESPACE* manual))
    (IF (AND object (NOT more?))
      (PROGN
	(IF FORCED-GET
	  (READ-REMOTE-OBJECT STUFF MANUAL NTH OBJECT)
	  (IF (SETQ NODES (NAME::GET-ATTRIBUTE-VALUE OBJECT :NODE))
	    (PROGN
	      (IF NTH
		(PROGN
		  (DOLIST (NODE NODES)
		    (IF (EQL NTH (SEND NODE :NTH))
		      (RETURN-FROM GET-STUFF-FROM-DOC-SERVER `(:node ,NODE))))
		  (RETURN-FROM GET-STUFF-FROM-DOC-SERVER
		     (READ-REMOTE-OBJECT STUFF MANUAL NTH OBJECT)))
		(IF (AND (= (LENGTH NODES) 1) (= (SEND (FIRST NODES) :MAX-NTH) 0))
		  (RETURN-FROM GET-STUFF-FROM-DOC-SERVER (CONS :node NODES))
		  (RETURN-FROM GET-STUFF-FROM-DOC-SERVER
		     (IF (= (LENGTH NODES) (1+ (SEND (FIRST NODES) :MAX-NTH)))
		       (LIST :nodes NODES)
		       (LIST :MULTIPLE-ATTRIBUTES OBJECT
			     (ENTRIES-ALIST STUFF (NAME::OBJECT-CLASS OBJECT))))))))
	    (READ-REMOTE-OBJECT STUFF MANUAL NTH))))
      (READ-REMOTE-OBJECT STUFF MANUAL NTH))))


(DEFUN READ-REMOTE-OBJECT (STUFF &OPTIONAL MANUAL NTH ORIGINAL-OBJECT)
  (LET (OBJ OBJECT REMOTE-LIST)
    (SETQ REMOTE-LIST
	  (NAME:REMOTE-CALL (VISIDOC-SERVER-LIST)
			    (FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
			    NIL T :READ-ITEM STUFF MANUAL
			    NTH))
    (IF (NULL REMOTE-LIST)
	(RETURN-FROM READ-REMOTE-OBJECT NIL)
	(PROGN
          (CASE (FIRST remote-list)
            (:ITEM                         ;List form is (:ITEM object nth (list-of-strings-and-lists))
             (SETQ object (SECOND REMOTE-LIST))
	     (NAME::ADD-OBJECT (NAME::OBJECT-NAME OBJECT) (NAME::OBJECT-CLASS OBJECT) :ATTRIBUTES
			       (MERGE-ATTRIBUTE-LISTS OBJECT ORIGINAL-OBJECT) :LOCAL T :NAMESPACE
			       *DOC-NAMESPACE*)
             (DOLIST (ITEM (FOURTH REMOTE-LIST))
               (WHEN (AND (LISTP ITEM)
                          (NOT
                            (NAME::LOOKUP-OBJECT (NAME::OBJECT-NAME (SETQ OBJ (FIRST ITEM)))
                                                 (NAME::OBJECT-CLASS OBJ) :NAMESPACE *DOC-NAMESPACE*
                                                 :LOCAL T)))
                 (NAME::ADD-OBJECT (NAME::OBJECT-NAME OBJ) (NAME::OBJECT-CLASS OBJ) :ATTRIBUTES
                                   (NAME::get-attribute-list OBJ) :NAMESPACE *DOC-NAMESPACE*
                                   :LOCAL T)))
	     ;;You have to lookup the object in the local namespace now because
	     ;;you need whatever attributes got merged!!!
	     (SETQ remote-list
		   (APPEND (LIST (FIRST remote-list)
				 (NAME::LOOKUP-OBJECT (NAME::OBJECT-NAME object)
						      (NAME::OBJECT-CLASS object) :NAMESPACE *DOC-NAMESPACE*
						      :LOCAL T))
			   (CDDR remote-list))))
            (:MULTIPLE-ATTRIBUTES
             (SETQ OBJECT (SECOND remote-list))
             (NAME::ADD-OBJECT (NAME::OBJECT-NAME OBJECT) (NAME::OBJECT-CLASS OBJECT) :ATTRIBUTES
                               (MERGE-ATTRIBUTE-LISTS OBJECT ORIGINAL-OBJECT) :LOCAL T :NAMESPACE
                               *DOC-NAMESPACE*)
             (SETQ remote-list (NCONC remote-list (LIST (entries-alist (name:object-name object)
                                                                       (name:object-class object)))))
             remote-list)
            (:MULTIPLE-OBJECTS
             (DOLIST (item (SECOND remote-list))
               (UNLESS (NAME::LOOKUP-OBJECT (NAME::OBJECT-NAME item)
                                            (NAME::OBJECT-CLASS item) :NAMESPACE *DOC-NAMESPACE*
                                                   :LOCAL T)
                 (NAME::ADD-OBJECT (NAME::OBJECT-NAME item) (NAME::OBJECT-CLASS item) :ATTRIBUTES
                                   (NAME::get-attribute-list item) :NAMESPACE *DOC-NAMESPACE*
                                   :LOCAL T)))
             remote-list))))))


(DEFUN MERGE-ATTRIBUTE-LISTS (OBJ1 OBJ2)
  "Returns a proper attribute list that is the union of the two object's attribute lists.
The second object (obj2) can be nil, but not the first."
  (LET* ((A1 (AND OBJ1 (NAME::GET-ATTRIBUTE-LIST OBJ1)))
	 (A2 (AND OBJ2 (NAME::GET-ATTRIBUTE-LIST OBJ2))))
    (IF (NULL A2)
      A1
      (DO* ((NEW-ATTR-LIST A1)
	    (ATTR-LIST A2 (CDDR ATTR-LIST))
	    (ATTR-NAME (FIRST ATTR-LIST) (FIRST ATTR-LIST))
	    (ATTR-VAL (SECOND ATTR-LIST) (SECOND ATTR-LIST)))
	   ((NULL ATTR-LIST)
	    NEW-ATTR-LIST)
	(UNLESS (GETF A1 ATTR-NAME)
	  (PUSH ATTR-VAL NEW-ATTR-LIST)
	  (PUSH ATTR-NAME NEW-ATTR-LIST)))))) 


(DEFUN list-of-manuals ()
  (NAME:REMOTE-CALL (VISIDOC-SERVER-LIST)
		    (FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
		    t T :LIST-OF-MANUALS))


(DEFUN list-of-all-types ()
  (name:remote-call (VISIDOC-SERVER-LIST)
		    (FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
		    t T :LIST-OF-TYPES))


(DEFUN doc-apropos-retrieval (target
			      &optional (manuals (list-of-manuals)) (types (list-of-all-types)) (place :any))
  2"Return a list of strings from MANUALS that are names of objects of type TYPES containing TARGET
in their names at PLACE.
TARGET is a string or list of strings 
MANUALS is a manual name or list of manuals 
TYPES is a type specifier [eg, :FUNCTION, etc] or list of them,
PLACE is one of the keywords describing the doc-server's apropos match-method, either
  :ANY (the default) = Find the target string within any name in the namespace;
  :START = the target string must match the start of the namespace name;
  :END =  the target string must match the end of the namespace name;
  :WORDS = TARGET is a list of words [eg, '(\"word1\" \"word2\")] to try to match, take any of them
  :AND-WORDS = same as :WORDS, but a namespace name must have ALL the words in TARGET."*
  (name:remote-call (visidoc-server-list)
		    (FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
		    t T :APROPOS target
		    :manual manuals :type types :match-method place))


(DEFUN table-of-contents (manual)
  (LET ((ret-list
	  (NAME:REMOTE-CALL (VISIDOC-SERVER-LIST)
			    (FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
			    t T :TABLE-OF-CONTENTS manual))
	object obj)
    (DOLIST (l ret-list)
      (SETQ object (FIRST l))
      (IF (SETQ obj (name::lookup-object (name::object-name object)
				     manual :namespace *doc-namespace* :local t))
	  (name::add-object (name::object-name OBJECT) manual :attributes
			    (merge-attribute-lists OBJECT obj) :local t :namespace *doc-namespace*)
	  (name::add-object (name::object-name OBJECT) manual :attributes
			    (name::get-attribute-list OBJECT) :namespace *doc-namespace* :local t)))
    ret-list))


(DEFUN STORE-NODE-IN-NAMESPACE (NODE)
  "Stores a Zmacs node in the namespace."
  (LET* ((NAME (SEND NODE :NAME))
	 (CLASS (MANUAL-NAME NODE))
	 (OBJECT (NAME::LOOKUP-OBJECT NAME CLASS :NAMESPACE *DOC-NAMESPACE* :LOCAL T))
	 NODE-LIST)
    (IF OBJECT
      (PROGN
	(SETQ NODE-LIST (NAME::GET-ATTRIBUTE-VALUE OBJECT :NODE))
	(NAME::ADD-ATTRIBUTE NAME CLASS :NODE (PUSH NODE NODE-LIST) :NAMESPACE *DOC-NAMESPACE*
			     :LOCAL T))
      (NAME::ADD-OBJECT NAME CLASS :ATTRIBUTES `(:NODE (,NODE)) :NAMESPACE *DOC-NAMESPACE*
			:LOCAL T))
    OBJECT)) 


(DEFUN REMOVE-NODE-FROM-NAMESPACE (NODE)
  "Removes NODE from the attribute list of the namespace object represented by NODE."
  (LET* ((NAME (SEND NODE :NAME))
	 (CLASS (MANUAL-NAME NODE))
	 (OBJECT (NAME::LOOKUP-OBJECT NAME CLASS :NAMESPACE *DOC-NAMESPACE* :LOCAL T))
	 NODE-LIST)
    (WHEN OBJECT
      (IF (SETQ NODE-LIST (NAME::GET-ATTRIBUTE-VALUE OBJECT :NODE))
	(PROGN
	  (SETQ NODE-LIST (REMOVE NODE NODE-LIST))
	  (IF NODE-LIST
	    (NAME::ADD-ATTRIBUTE NAME CLASS :NODE NODE-LIST :NAMESPACE *DOC-NAMESPACE* :LOCAL T)
	    (NAME::DELETE-ATTRIBUTE NAME CLASS :NODE :NAMESPACE *DOC-NAMESPACE* :LOCAL T)))
	(NAME::DELETE-ATTRIBUTE NAME CLASS :NODE :NAMESPACE *DOC-NAMESPACE* :LOCAL T))))) 


(DEFUN NODE-IN-NAMESPACE-P (NAME MANUAL NTH)
  "Returns either nil (if the node is not in the namespace) or the node instance if it is."
  (LET* ((OBJECT (NAME::LOOKUP-OBJECT NAME MANUAL :NAMESPACE *DOC-NAMESPACE* :LOCAL T))
	 NODE-LIST)
    (WHEN OBJECT
      (SETQ NODE-LIST (NAME::GET-ATTRIBUTE-VALUE OBJECT :NODE))
      (IF (AND (= (LENGTH NODE-LIST) 1) (= NTH (SEND (FIRST NODE-LIST) :NTH)))
	(FIRST NODE-LIST)
	(DOLIST (NODE NODE-LIST)
	  (IF (= NTH (SEND NODE :NTH))
	    (RETURN NODE)))))))
 

(DEFUN OBJECT-MANUAL-NAME (OBJECT)
  "Given a namespace object, return the keyword name of the manual (its class) in which this object is found."
  (WHEN OBJECT
    (NAME::OBJECT-CLASS OBJECT)))

(PROCLAIM '(inline object-manual-name))


(DEFUN manual-fonts (manual)
  "Given a manual name, find the fonts list associated with its namespace object."
  (WHEN manual
    (name:get-attribute-value
      (find-manual-object manual)
      :fonts)))


(DEFUN OBJECT-NAME (OBJECT)
  "Given a namespace object, return the object's NAME."
  (WHEN OBJECT
    (NAME::OBJECT-NAME OBJECT)))
 
(PROCLAIM '(inline object-name))


(DEFUN MANUAL-NAME (NODE)
  (LOOP FOR SUP = (SEND NODE :SUPERIOR) DO
     (IF (OR (NULL SUP) (TYPEP SUP 'ZWEI-DOC-VIEWER-BUFFER))
       (RETURN (IF (NULL SUP)
		 NIL
		 (SEND SUP :NAMESPACE-NAME)))
       (SETQ NODE SUP)))) 


(DEFUN CHAPTER-ORDER (CHAPTER MANUAL)
  "Returns multiple values: the position of CHAPTER, as an NTH, in MANUAL; and the assoc-list for that chapter."
  (LET (CHAP-LIST
	OBJECT)
    (SETQ OBJECT
	  (NAME::LOOKUP-OBJECT MANUAL :NAMESPACE :NAMESPACE *DOC-NAMESPACE* :LOCAL T :READ-ONLY
			       T))
    (IF OBJECT
      (SETQ CHAP-LIST (NAME::GET-ATTRIBUTE-VALUE OBJECT :CHAPTER-FILES))
      (PROGN
	(SETQ OBJECT
	      (NAME:REMOTE-CALL (VISIDOC-SERVER-LIST)
				(FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
				T T :GET-OBJECT MANUAL :NAMESPACE))
	(SEND *DOC-NAMESPACE* :INTERNAL-ADD-OBJECT OBJECT)
	(SETQ CHAP-LIST (NAME::GET-ATTRIBUTE-VALUE OBJECT :CHAPTER-FILES))))
    (VALUES (POSITION CHAPTER CHAP-LIST :KEY #'CAR) (ASSOC CHAPTER CHAP-LIST)))) 


(DEFUN FIND-MANUAL-OBJECT (MANUAL)
  "Return the namespace object belonging to the manual object named MANUAL."
  (LET ((OBJECT (NAME::LOOKUP-OBJECT MANUAL :NAMESPACE :NAMESPACE *DOC-NAMESPACE* :LOCAL T)))
    (UNLESS OBJECT
      (WHEN (SETQ OBJECT
	     (NAME:REMOTE-CALL (VISIDOC-SERVER-LIST)
			       (FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
			       T T :GET-OBJECT MANUAL :NAMESPACE))
	(NAME::ADD-OBJECT MANUAL :NAMESPACE :ATTRIBUTES (NAME::GET-ATTRIBUTE-LIST OBJECT)
			  :NAMESPACE *DOC-NAMESPACE* :LOCAL T)))
    OBJECT)) 


(DEFUN SAFE-FIND-OBJECT (OBJECT-NAME NS MANUAL &aux index)
  (WHEN (AND (SETQ index (STRING-SEARCH-SET '(#\:) object-name))
	     (< 0 index) 
	       (FIND-PACKAGE (READ-FROM-STRING object-name t nil :end index)))
      (SETQ object-name (SUBSEQ object-name (1+ index))))
  (MULTIPLE-VALUE-BIND (OBJECT CLASS) (NAME::FIND-OBJECT OBJECT-NAME NS MANUAL)
    (UNLESS OBJECT
      (WHEN (SETQ OBJECT
	     (NAME:REMOTE-CALL (VISIDOC-SERVER-LIST)
			       (FORMAT nil "visidoc-server~@[-~a~]"
				       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
			       T T :GET-OBJECT OBJECT-NAME MANUAL))
	(NAME::ADD-OBJECT OBJECT-NAME MANUAL :ATTRIBUTES (NAME::GET-ATTRIBUTE-LIST OBJECT)
			  :NAMESPACE *DOC-NAMESPACE* :LOCAL T))
      (SETQ CLASS MANUAL))
    (VALUES OBJECT CLASS))) 


(DEFUN DOC-OBJECT-POSITION (ATTRIB CLASS)
  "Returns the NTH position number of this attribute in the doc namespace, such as
:CHAPTER is 0, etc."
  (LET* ((local-OBJECT (name:find-object class *doc-namespace* :namespace))  ;Search locally first
	 (object (OR local-object
                     (NAME:REMOTE-CALL (VISIDOC-SERVER-LIST)
				       (FORMAT nil "visidoc-server~@[-~a~]"
					       (GETF (SYMBOL-PLIST '*doc-namespace*) :version))
				       T T :GET-OBJECT CLASS :NAMESPACE))))
    (WHEN (NULL local-object)
      (SEND *doc-namespace* :internal-add-object object))
    (POSITION ATTRIB (NAME::GET-ATTRIBUTE-VALUE OBJECT :LIST-ORDER))))


(DEFUN DOC-OBJECT-ATTRIBUTE-LIST (OBJECT NTH)
  (SECOND (NTH NTH (ENTRIES-ALIST (NAME::OBJECT-NAME OBJECT) (NAME::OBJECT-CLASS OBJECT))))) 


(DEFUN FIND-DOC-OBJECT-ATTRIBUTE (ATTRIBUTE OBJECT CLASS NTH)
  (MULTIPLE-VALUE-SETQ (OBJECT CLASS)
    (SAFE-FIND-OBJECT OBJECT *DOC-NAMESPACE* CLASS))
  (NTH (DOC-OBJECT-POSITION ATTRIBUTE CLASS) (DOC-OBJECT-ATTRIBUTE-LIST OBJECT NTH))) 

(PROCLAIM '(INLINE FIND-DOC-OBJECT-ATTRIBUTE)) 


(DEFUN DOC-OBJECT-SUPERIOR (OBJECT-NAME MANUAL &OPTIONAL NTH)
  "Returns the superior of the object named OBJECT-NAME as a string.
The manual name and type are already known: the manual is the same as the
inferior, and the type is :TOPIC. Assume Nth is 0."
  (FIND-DOC-OBJECT-ATTRIBUTE :SUPERIOR OBJECT-NAME MANUAL NTH)) 


(DEFUN DOC-NODE-SUPERIOR (NODE)
  "Returns the superior of the object associated with NODE, as a string.
The manual name and type are already known: the manual is the same as the
inferior, and the type is :TOPIC. Assume Nth is 0."
  (FIND-DOC-OBJECT-ATTRIBUTE :SUPERIOR (SEND NODE :NAME) (MANUAL-NAME NODE) (SEND NODE :NTH))) 


(DEFUN DOC-OBJECT-INFERIORS (OBJECT-NAME MANUAL &OPTIONAL NTH)
  "Return the list of inferiors of the object named OBJECT-NAME, as a list of strings. 
The manual name and type are already known: the manual is the same as the
superior, and the type is :TOPIC. Assume Nth is 0."
  (FIND-DOC-OBJECT-ATTRIBUTE :INFERIORS OBJECT-NAME MANUAL NTH)) 


(DEFUN DOC-NODE-INFERIORS (NODE)
  "Return the list of inferiors of the object associated with NODE, as a list of strings. 
The manual name and type are already known: the manual is the same as the
superior, and the type is :TOPIC. Assume Nth is 0."
  (FIND-DOC-OBJECT-ATTRIBUTE :INFERIORS (SEND NODE :NAME) (MANUAL-NAME NODE) (SEND NODE :NTH))) 


(DEFUN DOC-OBJECT-NEXT (OBJECT-NAME MANUAL &OPTIONAL NTH)
  "Return the next object of the object named OBJECT-NAME, as a string. 
The manual name is already known: it is the same. Assume Nth is 0."
  (FIND-DOC-OBJECT-ATTRIBUTE :NEXT OBJECT-NAME MANUAL NTH)) 


(DEFUN DOC-NODE-NEXT (NODE)
  "Return the next object of the object associated with NODE, as a string. 
The manual name is already known: it is the same. Assume Nth is 0."
  (FIND-DOC-OBJECT-ATTRIBUTE :NEXT (SEND NODE :NAME) (MANUAL-NAME NODE) (SEND NODE :NTH))) 


(DEFUN DOC-OBJECT-PREVIOUS (OBJECT-NAME MANUAL &OPTIONAL NTH)
  "Return the next object of the object named OBJECT-NAME, as a string. 
The manual name and type are already known: the manual is the same,
 and the type is :TOPIC. Assume Nth is 0."
  (FIND-DOC-OBJECT-ATTRIBUTE :PREVIOUS OBJECT-NAME MANUAL NTH)) 


(DEFUN DOC-NODE-PREVIOUS (NODE)
  "Return the next object of the object associated with NODE, as a string. 
The manual name and type are already known: the manual is the same,
 and the type is :TOPIC. Assume Nth is 0."
  (FIND-DOC-OBJECT-ATTRIBUTE :PREVIOUS (SEND NODE :NAME) (MANUAL-NAME NODE) (SEND NODE :NTH))) 


(DEFUN DOC-OBJECT-PAGE (OBJECT-NAME MANUAL &OPTIONAL NTH)
  "Return the Page identifier for the object named OBJECT-NAME, as a string."
  (LET ((STR (FIND-DOC-OBJECT-ATTRIBUTE :PAGE OBJECT-NAME MANUAL NTH)))
    (CONCATENATE 'STRING (FIRST STR)
		 (STRING (IF (NUMBERP (SECOND STR))
			   (FORMAT NIL "~d" (SECOND STR))
			   (SECOND STR)))))) 


(DEFUN DOC-NODE-PAGE (NODE)
  "Return the Page identifier for the object associated with NODE, as a string."
  (LET* ((MANUAL (MANUAL-NAME NODE))
	 (STR (FIND-DOC-OBJECT-ATTRIBUTE :PAGE (SEND NODE :NAME) MANUAL (SEND NODE :NTH))))
    (WHEN STR
      (CONCATENATE 'STRING (FIRST STR)
		   (STRING
		    (IF (NUMBERP (SECOND STR))
		      (FORMAT NIL "~d" (SECOND STR))
		      (SECOND STR)))))))