;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Written 03/28/91 12:56:34 by File Server, ;;; Reason: patch sent from Mark Young at TI ;;; while running on KSL-EXP-5 from band LOD0 ;;; With SYSTEM 6.41, VIRTUAL-MEMORY 6.3, EH 6.8, MAKE-SYSTEM 6.5, MICRONET 6.0, LOCAL-FILE 6.2, ;;; BASIC-PATHNAME 6.5, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8, NETWORK-NAMESPACE 6.1, ;;; DISK-IO 6.4, DISK-LABEL 6.1, BASIC-FILE 6.15, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2, ;;; COMPILER 6.18, TV 6.32, DATALINK 6.0, CHAOSNET 6.9, GC 6.7, MEMORY-AUX 6.0, NVRAM 6.4, ;;; SYSLOG 6.2, STREAMER-TAPE 6.6, UCL 6.1, INPUT-EDITOR 6.1, METER 6.2, ZWEI 6.28, ;;; DEBUG-TOOLS 6.5, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.8, MAC-PRINTER-TYPES 6.2, PRINTER-TYPES 6.2, ;;; IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.9, TELNET 6.1, VT100 6.0, ;;; NAMESPACE-EDITOR 6.7, PROFILE 6.3, VISIDOC 6.7, TI-CLOS 6.53, CLEH 6.5, IP 3.50, ;;; RPC 6.2, NFS 3.9, Experimental KSL-PATCHES 10.2, VISIDOC-SERVER 6.2, microcode 660, ;;; Band Name: 6.1(0), KSL9 10.2, 16-Jan #!C ; From file PATCH.LISP#> TEMP; KSL-EXP-5: #10R USER#: (lisp:COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "USER")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* SYS:COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* SYS::*COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: TEMP; PATCH.#" ;;; -*- Mode: Common-Lisp; Package: User; Base: 10.; Patch-File: T -*- ;;; Reason: Changed (:method visidoc-server :initial-server-setup) to save changes to XLD ;;; file is the user desires - which must be done if a disk-save is NOT going to ;;; be performed after doing a (dox:initialize-visidoc-server) where changes are ;;; made to the default pathnames of the various Lm:manuals; subdirectories. ;;; 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 252.227-7013. ;;; ;;; TEXAS INSTRUMENTS INCORPORATED ;;; P.O. BOX 149149, M/S 2151 ;;; AUSTIN, TEXAS 78714-9149 ;;; ;;; Copyright (C) 1990 Texas Instruments Incorporated. ;;; All rights reserved. ;;; Written 02/22/91 09:24:10 by BOOT-INIT, ;;; while running on Quebec from band LOD1 ;;; With SYSTEM 6.45, VIRTUAL-MEMORY 6.3, EH 6.8, MAKE-SYSTEM 6.5, MICRONET 6.0, LOCAL-FILE 6.2, ;;; BASIC-PATHNAME 6.6, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.8, NETWORK-NAMESPACE 6.1, ;;; DISK-IO 6.4, DISK-LABEL 6.1, BASIC-FILE 6.15, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.2, ;;; COMPILER 6.20, TV 6.35, DATALINK 6.0, CHAOSNET 6.9, GC 6.9, MEMORY-AUX 6.0, NVRAM 6.5, ;;; SYSLOG 6.2, STREAMER-TAPE 6.8, UCL 6.1, INPUT-EDITOR 6.1, METER 6.2, ZWEI 6.30, ;;; DEBUG-TOOLS 6.5, NETWORK-SUPPORT 6.1, NETWORK-SERVICE 6.3, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, PRINTER 6.9, MAC-PRINTER-TYPES 6.2, PRINTER-TYPES 6.2, ;;; IMAGEN 6.1, SUGGESTIONS 6.1, MAIL-DAEMON 6.6, MAIL-READER 6.9, TELNET 6.1, VT100 6.0, ;;; NAMESPACE-EDITOR 6.10, PROFILE 6.3, VISIDOC 6.8, TI-CLOS 6.54, CLEH 6.5, IP 3.67, ;;; Experimental BUG 11.23, Experimental CLX 7.5, Experimental CLUE 7.24, X11M 6.36, ;;; Experimental CLIO 1.0, VISIDOC-SERVER 6.3, microcode 489, Band Name: Release 6.1 + SLE 8/10 ;;; SPR 21327 Change to save changed manuals pathnames during (dox:intialize-visidoc-server) ;;; in a new XLD if the user desires - if a disk-save is NOT going to be performed. This is ;;; the case when trying to maintain multiple versions of visidoc servers, and both versions ;;; of the manuals directories (in separate databases) WITHOUT doing a disk-save. #!C ; From file NAMESPACE-SERVER.LISP#> VISIDOC.SERVER; Hotel: #10R DOX#: (lisp: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.#" (DEFMETHOD (visidoc-server :initial-server-setup) (&optional version) "Initializes the host and directories for the manual data files of a VISIDOC server. VERSION is a keyword of the form :REL--. If VERSION is nil, then the :VERSION info is looked for as an attribute of the :DOMAIN-NAME object in the :NAMESPACE class. If nothing is found there, the default is the same as the current load band." (LET* ((servers (net:get-site-option :visidoc-servers nil)) (release (OR version (name:lookup-attribute-value name:domain-name :namespace :version :namespace self :local t))) (product (dolist (item sys:*DEFINED-PRODUCTS*) ; DAB 03-20-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-22-89 (return item)))) (manuals nil) info flag sym save) ;;If no release number was found, then we have to create it and add the info to the namespace. (UNLESS release (SETQ release (READ-FROM-STRING (FORMAT nil ":REL-~s-~s" (SEND product :major-version) (SEND product :minor-version)))) (SETF name:domain-name (FORMAT nil "visidoc-server~@[-~a~]" release)) (name:add-attribute name:domain-name :namespace :version release :namespace self :local t)) ;;Add namespace to list of known servers on the :SITE info (IF servers (name:add-attribute site-name :site :VISIDOC-SERVERS (LET ((rel-servers (ASSOC release servers))) (IF rel-servers (PROGN (PUSHNEW si:local-host-name (CADR rel-servers) :test #'string-equal) servers) (PUSH-END (LIST release (LIST si:local-host-name)) servers)))) (name:add-attribute site-name :site :VISIDOC-SERVERS (LIST (LIST release (LIST si:local-host-name))))) ;;ok.. SITE info updated. Now update manuals info for this server instance if needed. ;;To do this, first make a menu-item list out of the default pathnames. Then use a CVV menu ;;to update the pathnames. (DOLIST (man (SEND self :list-of-manuals)) (PUSH-END (LIST (SETQ sym (INTERN (CONCATENATE 'STRING (STRING man) "-manual"))) man (SETF (SYMBOL-VALUE sym) (MAKE-PATHNAME :host (SECOND (ASSOC :host (SETQ info (get-general-info :FILES-INFO man)))) :device (SECOND (ASSOC :device info)) :directory (SECOND (ASSOC :directory info)) :name :wild :type (SECOND (ASSOC :extension info)))) info) manuals)) ;;make symbols SPECIAL so CVV will work. (PROCLAIM `(SPECIAL ,@(MAPCAR #'CAR manuals))) (CONDITION-CASE () (w:choose-variable-values (LOOP for alist in manuals collect (LIST (CAR alist) :pathname (SYMBOL-VALUE (CAR alist)))) :label (FORMAT nil "~:@(~a~) pathnames for manual files:" name:domain-name) :margin-choices '(("Abort" (SIGNAL-CONDITION eh:*abort-object*)))) (sys:abort (FORMAT t "~&Location of manuals has been set to the defaults")) (:no-error (DOLIST (man manuals) (SETQ flag nil) (LET* ((sym (FIRST man)) (symval (MAKE-PATHNAME :defaults (SYMBOL-VALUE sym))) (host (HOST-NAMESTRING symval)) (device (pathname-device symval)) (dir (DIRECTORY-NAMESTRING symval))) ;;check hosts (WHEN (NOT (STRING-EQUAL (HOST-NAMESTRING (THIRD man)) host)) (RPLACD (ASSOC :host (FOURTH man)) (LIST (SUBSEQ host 0 (1- (length host))))) (SETQ flag t)) ;; check device (WHEN (NOT (STRING-EQUAL (PATHNAME-DEVICE (THIRD man)) device)) (IF (ASSOC :device (FOURTH man)) (RPLACD (ASSOC :device (FOURTH man)) (LIST device)) (SETF (FOURTH man) (CONS (LIST :device device) (FOURTH man)))) (SETQ flag t)) ;;check directories (WHEN (NOT (STRING-EQUAL (DIRECTORY-NAMESTRING (THIRD man)) dir)) (RPLACD (ASSOC :directory (FOURTH man)) (LIST (SEND symval :directory))) (SETQ flag t)) ;;When FLAG is set, we changed at least one part of the pathname. (WHEN flag (SETQ save t) (name:add-attribute (SECOND man) :namespace :FILES-INFO (FOURTH man) :namespace self :local t)) )) ;;Iff we actually made any changes, save the namespace. (WHEN save ;; may 02/22/91 Added the prompt and uncommented out the call to save-visidoc-server ;; Also added warning about interacting with namespace during save. SPR 21327 (when (yes-or-no-p "~%Do you plan to do a disk-save before rebooting ?~ ~%If you do your changes will be saved automatically.~ ~%If you don't a new version of~ ~%~s,~ ~%will be created to save the changes now for later rebooting." (namestring (send self :namespace-file-pathname))) ;; may 02/22/91 This was originally commented out of the source code ;;; (PROCESS-RUN-FUNCTION ;;; (FORMAT nil "Save ~:@(~a~)" name:domain-name) ;;; #'save-visidoc-server self) (format t "~%Warning: Do not try to access the visidoc-server namespace or~ ~%the manuals until this function completes creation of the new XLD.") (save-visidoc-server self) )) )) manuals)) )) ))