;;; -*- Mode: Common-Lisp; Package: DOX; Base: 10.; Patch-File: T -*-

;;; Reason: Fixed get-doc-object-start-and-end  to handle case of an obj-name of "".

;;;                           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, M/S 2151             
;;;   AUSTIN, TEXAS 78769                 
;;;
;;; Copyright (C) 1989 Texas Instruments Incorporated.
;;; All rights reserved.

;;; Patch file for VISIDOC-SERVER version 6.1
;;; Written 08/24/89 13:32:22 by BERGER,
;;; while running on ARIES from band LOD1
;;; With SYSTEM 6.14, VIRTUAL-MEMORY 6.1, EH 6.4, MAKE-SYSTEM 6.0, MICRONET 6.0, LOCAL-FILE 6.0,
;;;  BASIC-PATHNAME 6.1, NETWORK-SUPPORT-COLD 6.0, BASIC-NAMESPACE 6.2, NETWORK-NAMESPACE 6.0,
;;;  DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.2, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0,
;;;  COMPILER 6.10, TV 6.15, DATALINK 6.0, CHAOSNET 6.0, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.1,
;;;  SYSLOG 6.1, STREAMER-TAPE 6.4, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.5,
;;;  DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.1, DATALINK-DISPLAYS 6.0,
;;;  FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.3, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.1,
;;;  IMAGEN 6.0, SUGGESTIONS 6.0, MAIL-DAEMON 6.2, MAIL-READER 6.2, TELNET 6.0, VT100 6.0,
;;;  NAMESPACE-EDITOR 6.0, PROFILE 6.1, VISIDOC 6.2, TI-CLOS 6.20, CLEH 6.5, IP 3.47,
;;;  Experimental CLX 6.2, CLUE 6.10, X11M 6.13, Experimental BUG 11.15, DECNET 1.69,
;;;  VISIDOC-SERVER 6.0,  microcode 429, Band Name: Rel 6.0 + SLE 7/28

#!C
; From file NAMESPACE-SERVER.LISP#> VISIDOC.SERVER; SYS:
#10R DOX#:
(COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "DOX"))
                          (SI:*LISP-MODE* :COMMON-LISP)
                          (*READTABLE* SYS:COMMON-LISP-READTABLE)
                          (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*))
  (COMPILER#:PATCH-SOURCE-FILE "SYS: VISIDOC.SERVER; NAMESPACE-SERVER.#"


(DEFUN get-doc-object-start-and-end (obj-name manual chapter min-start max-end sup-name superior-nth)
  "Returns as multiple values the start and end file position, an object and Nth definition.
Watches for multiple definitions, and
tests that the definition returned is within the chapter, min-start, and max-end requirements."
;;Need SUP-NAME and SUPERIOR-NTH to make sure that if an inferior has the same name as its
;;superior, we don't want to return the wrong set of information!!  11/10/87
  (DECLARE (:self-flavor visidoc-server)
           (VALUES start end object nth))
  (CATCH 'Found
    (LET* ((data-list (name:lookup-attribute-value manual :NAMESPACE :LIST-ORDER :namespace self))
           (object (name:find-object obj-name self manual))
           (attributes (when  object ; DAB 08-24-89 Handle case  were obj-name is "".
			 (zwei:entries-alist-internal (name:get-attribute-list object)))))
      (COND ((NULL attributes)
             (THROW 'Found (VALUES nil nil nil)))
            ;; Check for multiple types
            ((> (LENGTH attributes) 1)
             (DO* ((lst attributes (CDR lst))
                   (att-list (FIRST lst) (FIRST lst))
                   (type (FIRST att-list) (FIRST att-list))
                   (atts (SECOND att-list) (SECOND att-list))
                   (NTH (THIRD att-list) (THIRD att-list)))
                  ((NULL att-list))
               (IF (AND (NOT (AND (STRING-EQUAL sup-name obj-name)
				  (EQL superior-nth nth)))  ;;we don't want the superior's entry
			(EQL chapter (data-from-list :CHAPTER data-list atts))
                        (<= min-start (data-from-list :START data-list atts))
                        (>= max-end (data-from-list :END data-list atts)))
                   (THROW 'Found (VALUES (data-from-list :START data-list atts)
                                         (data-from-list :END data-list atts)
                                         object
                                         nth)))))
            (t (SETQ attributes (SECOND (FIRST attributes)))
               (THROW 'Found (VALUES (data-from-list :START data-list attributes)
                                     (data-from-list :END   data-list attributes)
                                     object
                                     0)))))))
))
