;;; -*- Mode: Common-Lisp; Package: ZWEI; Base: 10.; Patch-File: T -*- ;;; Reason: Fixed SAFE-FIND-OBJECT to ignore errors trying to parse strings for ":". It was assuming this was a package prefix. May not always be the case. ;;; 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. ;;; Written 08/31/89 09:09:38 by BERGER, ;;; while running on ARIES from band LOD1 ;;; With SYSTEM 6.15, 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.3, 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.1, microcode 429, Band Name: Rel 6.0 + SLE 7/28 #!C ; From file CLIENT.LISP#> VISIDOC; SYS: #10R ZWEI#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "ZWEI")) (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; CLIENT.#" (DEFUN SAFE-FIND-OBJECT (OBJECT-NAME NS MANUAL) (let (OBJECT CLASS index temp-object-name) ; DAB 08-31-89 (WHEN (AND (SETQ index (STRING-SEARCH-SET '(#\:) object-name)) (< 0 index) (FIND-PACKAGE (ignore-errors (READ-FROM-STRING object-name t nil :end index)))) (SETQ temp-object-name (SUBSEQ object-name (1+ index)))) ; DAB 08-31-89 (or (MULTIPLE-VALUE-setq (OBJECT CLASS) (NAME::FIND-OBJECT OBJECT-NAME NS MANUAL)) ;;If we did not get it above, try it without the package perfix. (and temp-object-name ; DAB 08-31-89 (MULTIPLE-VALUE-SETQ (OBJECT CLASS) (NAME::FIND-OBJECT temp-object-name *DOC-NAMESPACE* manual)) (setf object-name temp-object-name))) (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))) )) #!C ; From file Document-viewer.LISP#> VISIDOC; SYS: #10R ZWEI#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "ZWEI")) (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; Document-viewer.#" (defun doc-viewer-top-level (fname &optional (manual nil) (nth nil) &aux index temp-fname) "Top level function to enter the Document Server. FNAME is the name of what we want to document. MANUAL is the keyword (ie. :LISP, :IO, :WINDOWS) identifying the manual in which FNAME is found. NTH is the index into the list returned from the (ENTRIES-ALIST) function for FNAME." (DECLARE (inline object-manual-name)) (PKG-BIND (FIND-PACKAGE 'zwei) ;;prevent wierdness when constructing diagram lines (SETQ FNAME (STRING-UPCASE (STRING-TRIM '(#\SPACE) FNAME))) (WHEN (AND (SETQ index (STRING-SEARCH-SET '(#\:) fname)) (< 0 index) (FIND-PACKAGE (ignore-errors (READ-FROM-STRING fname t nil :end index)))) (SETQ temp-fname (SUBSEQ fname (1+ index)))) (LET* ((info-list (or (get-stuff-from-doc-server fname :manual manual :nth nth) (and temp-fname (prog1 (and (get-stuff-from-doc-server temp-fname :manual manual :nth nth) (setf fname temp-fname)))))) object buffer node key) ;;Get-stuff-from-doc-server returns a list where the CAR is a keyword, ;;and the CDR is one of five values: ;; ;; keyword rest of list ;; -------- ----------------------------------------------------------------------- ;;1) :NODE a node instance if nth was specified and that reference has been created before ;;2) :NODES a list of nodes if ALL multiple references for a manual have been viewed before ;;3) :ITEM a list of the object, its nth position in the name's own (ENTRIES-ALIST..) ;; value, and a list of lists of subordinate object and nth pairs ;;4) :MULTIPLE-ATTRIBUTES a list of the object, and the object's (ENTRIES-ALIST..) value ;;5) :MULTIPLE-OBJECTS a list of the OBJECTS ;; ;; A return value of NIL means no object was found. (SETQ key (CAR info-list) info-list (CDR info-list)) ;;If there is no entry, go to the local machine and pull up any internal documentation. (CASE key (NIL (format t "~%~%There is no on-line Manual Documentation for ~a~%" fname) (if (position #\space (the string fname) :test #'CHAR=) (format t "~&~s was not found~%" fname) (doc-viewer-long-documentation (READ-FROM-STRING (STRING fname))))) ;;;This is a BRAND NEW ENTRY and needs to be put into a node 'n linked 'n stuff. (:item (SETQ object (CAR info-list) manual (OR manual (object-manual-name object)) buffer (find-doc-viewer-buffer-named manual)) (insert-and-select fname (entries-alist fname manual) (SECOND info-list) (THIRD info-list) manual buffer)) ;;A single node was returned (:node (select-buffer-and-expand-node (CAR info-list))) ;;;All references have been pulled into the doc viewer before. ;;;Do something to pick and go to the right node. (:nodes (SETQ info-list (CAR info-list)) (IF (< 1 (LENGTH info-list)) (WHEN (SETQ node (choose-a-node info-list)) (select-buffer-and-expand-node node)) (select-buffer-and-expand-node (CAR info-list)))) ;;;There are multiple references (:multiple-attributes (SETQ nth (pick-the-right-one fname (SECOND info-list))) (WHEN nth (doc-viewer-top-level fname (object-manual-name (CAR info-list)) nth))) ;;There are multiple OBJECTS!!! (:multiple-objects (MULTIPLE-VALUE-SETQ (nth manual) (pick-the-right-one fname (CAR info-list))) (WHEN (AND manual nth) (doc-viewer-top-level fname manual nth))) )) dis-none)) ))