;;; -*- Mode: Common-Lisp; Package: SYS; Base: 10.; Patch-File: T -*- ;;; Reason: Added special handling for CHAOSNET and VISIDOC-SERVER in *system-deletion-table*. [10665] ;;; 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 SHRINK-TOOLS version 6.3 ;;; Written 11/30/89 08:10:32 by BERGER, ;;; while running on ARIES from band LODX ;;; With SYSTEM 6.26, VIRTUAL-MEMORY 6.3, EH 6.5, MAKE-SYSTEM 6.2, MICRONET 6.0, LOCAL-FILE 6.1, ;;; BASIC-PATHNAME 6.2, NETWORK-SUPPORT-COLD 6.2, BASIC-NAMESPACE 6.7, NETWORK-NAMESPACE 6.0, ;;; DISK-IO 6.1, DISK-LABEL 6.0, BASIC-FILE 6.6, MAC-PATHNAME 6.0, NETWORK-PATHNAME 6.0, ;;; COMPILER 6.14, TV 6.19, DATALINK 6.0, CHAOSNET 6.5, GC 6.3, MEMORY-AUX 6.0, NVRAM 6.2, ;;; SYSLOG 6.2, STREAMER-TAPE 6.5, UCL 6.0, INPUT-EDITOR 6.0, METER 6.1, ZWEI 6.8, ;;; DEBUG-TOOLS 6.3, NETWORK-SUPPORT 6.0, NETWORK-SERVICE 6.2, DATALINK-DISPLAYS 6.0, ;;; FONT-EDITOR 6.1, SERIAL 6.0, MAC-PRINTER-TYPES 6.1, PRINTER-TYPES 6.2, IMAGEN 6.1, ;;; SUGGESTIONS 6.1, MAIL-DAEMON 6.3, MAIL-READER 6.6, TELNET 6.0, VT100 6.0, NAMESPACE-EDITOR 6.4, ;;; PROFILE 6.2, VISIDOC 6.5, TI-CLOS 6.26, CLEH 6.5, IP 3.56, Experimental CLX 6.7, ;;; CLUE 6.35, X11M 6.17, Experimental BUG 11.17, PRINTER 6.3, Experimental SHRINK-TOOLS 6.1, ;;; microcode 429, Band Name: rel6.0 10/23 #!C ; From file DELETE-SYSTEM.LISP#> BAND-TOOLS; SYS: #10R SYSTEM#: (COMPILER-LET ((*PACKAGE* (FIND-PACKAGE "SYSTEM")) (SI:*LISP-MODE* :COMMON-LISP) (*READTABLE* COMMON-LISP-READTABLE) (SI:*READER-SYMBOL-SUBSTITUTIONS* *COMMON-LISP-SYMBOL-SUBSTITUTIONS*)) (COMPILER#:PATCH-SOURCE-FILE "SYS: BAND-TOOLS; DELETE-SYSTEM.#" (defparameter *system-deletion-table* '(;; Systems needing special handling: (:ZMACS (progn (when (and (boundp 'zwei:*zmacs-buffer-list*) zwei:*zmacs-buffer-list* (ask-unless-batch "Kill all Zmacs buffers?")) (dolist (b zwei:*zmacs-buffer-list*) (send b :kill))) (delete-system :zmacs :recursivep t ;; functions used by rubout handler in Lisp Listener :keep-symbols (append *keep-symbols* 'zwei:(print-arglist char-syntax print-arglist-internal create-interval create-bp create-line insert make-node mung-bp-interval tick mung-node bp-node mung-line set-line-array-type set-line-length insert-within-line ))))) (:COMPILER (delete-system :COMPILER :keep-symbols (append *keep-symbols* '( LOCAL-DECLARATIONS FILE-LOCAL-DECLARATIONS UNDO-DECLARATIONS-FLAG COMPILER:QC-FILE-IN-PROGRESS ; used in flavors PUTDECL GETDECL ;; used by FASLOAD: COMPILER::EXPR-SXHASH COMPILER::FUNCTION-EXPR-SXHASH COMPILER:INTERPRETED-DEF ; use by FUNCTION-EXPR-SXHASH )) :recursivep t)) (:suggestions (when (or (not (find-system-named :suggestions t t)) (yes-or-no-p "Deleting Suggestions will probably break the window system! Try to do it anyway?")) (delete-system :suggestions :recursivep t))) (:streamer-tape (delete-system :streamer-tape ;; following used by FS:MAGTAPE-FILEHANDLE :keep-symbols (cons (and (find-package "MT") (find-symbol "MT-FILEHANDLE" "MT")) *keep-symbols*) :recursivep t)) (:debug-tools (delete-system :debug-tools ;; this function is used in Zmacs :keep-symbols (cons 'tv:function-spec-p *keep-symbols*) :recursivep t)) ;; Aliases for package names different from the system name: (:MT (delete-system :streamer-tape)) (:NETWORK-FILE-SYSTEM (delete-system :NFS)) (:REMOTE-PROCEDURE-CALL (delete-system :RPC)) (:ZLC (delete-system :zetalisp-support)) (:NSE (delete-system :namespace-editor)) (:SRCCOM (unload-file "SYS:ZMACS;SRCCOM")) ;; Elements of *FEATURES* that are not system names: (:flavors (when (unload-file "SYS:KERNEL;FLAVOR") (remove-feature :flavors))) (:defstruct (when (unload-file "SYS:KERNEL;STRUCTURE") (remove-feature :defstruct))) (:loop (when (unload-file "SYS:KERNEL;LOOP") (remove-feature :loop))) (:sort (when (unload-file "SYS:KERNEL;SORT") (remove-feature :sort))) (:fasload (progn (undefine-function 'fasload) (undefine-function 'fasload-internal) (remove-feature :fasload))) (:trace (when (unload-file '("SYS:KERNEL;TRACE" "SYS:DEBUG-TOOLS;TRACE-WINDOW") :keep-symbols (cons '*trace-output* *keep-symbols*)) (delete-system :trace :recursivep t) (remove-feature :trace))) (:grindef (progn (undefine-function 'grindef) (undefine-function 'grindef-1) (undefine-function 'pprint-def) (remove-feature :grindef))) (:CHAOSNET (delete-system :chaosnet ; DAB 11-30-89 Add special handling for CHAOSNET [10665] ;; These variables are used by NFS. :keep-symbols (list* 'fs:server-login 'fs:server-login-id *keep-symbols*) :recursivep t)) (:visidoc-server (let ((server-list (when (find-symbol "*VISIDOC-SERVER-NAMESPACES*" 'dox) (symbol-value (find-symbol "*VISIDOC-SERVER-NAMESPACES*" 'dox))))) (debug-print " Flushing Visidoc Servers.") (dolist (Server server-list) (name:delete-namespace (send server :domain-name))) (delete-system :visidoc-server :keep-symbols *keep-symbols* :recursivep t))) ;; Other major functions that are not separate systems: (PPRINT (when (unload-file "SYS:KERNEL;PPRINT") (remove-feature :grindef))) (FORMAT (when (unload-file "SYS:KERNEL;FORMAT") (fset 'format #'dummy-format))) (ADVISE (unload-file "SYS:KERNEL;ADVISE")) (APROPOS (unload-file "SYS:KERNEL;APROPOS")) (DESCRIBE (unload-file "SYS:KERNEL;DESCRIBE")) (WHO-CALLS (unload-file "SYS:KERNEL;WHO-CALLS")) (LOAD (let ((*keep-symbols* (list* 'si:get-file-loaded-id 'si:local-binary-file-type *keep-symbols*))) (when (unload-file (function-source-file 'fasload)) (remove-feature :fasload)) (dolist (x '( LOAD FS:LOAD-1 LOAD-PATCHES LOAD-AND-SAVE-PATCHES READFILE)) (when (fboundp x) (delete-system x :recursivep t))) )) ("UNFASL" (unload-file "SYS:COMPILER;UNFASL")) ("FINGER" (progn (unload-file '("SYS:NETWORK-SERVICE;FINGER" "SYS:NETWORK-SERVICE;FINGER-WINDOW")) (delete-system "FINGER" :recursivep t))) (sys:BAND-CLEANER (let ((file (function-source-file 'sys:band-cleaner))) (if file (unload-file file) ;; else band-cleaner has deleted source file properties. (when (and (fboundp 'sys:band-cleaner) (ask-unless-batch "Un-define function ~S ?" 'sys:band-cleaner)) (mapc #'undefine-function 'sys:( band-cleaner delete-debug-info set-debug-info-struct gc-pathnames clean-pathnames cdr-code-plists delete-previous-definition-property )) t)))) ;; Other groups of functions: (:LOCAL-FS ;; local Explorer file system (unload-file '(; release 3 pathnames: "SYS:FILE;FSDEFS" "SYS:FILE;FSMACROS" "SYS:FILE;FSSTR" "SYS:FILE;VBAT" "SYS:FILE;FSGUTS" "SYS:FILE;LOCAL-FILE-ACCESS" ;; release 4 pathnames: "SYS:LOCAL-FILE;FSDEFS" "SYS:LOCAL-FILE;FSMACROS" "SYS:LOCAL-FILE;FSSTR" "SYS:LOCAL-FILE;VBAT" "SYS:LOCAL-FILE;FSGUTS" "SYS:LOCAL-FILE;LOCAL-FILE-ACCESS"))) (:INFIX (unload-file "SYS:KERNEL;INFIX")) (:PLANE (unload-file "SYS:KERNEL;PLANE")) (:PEEK (when (unload-file "SYS:DEBUG-TOOLS;PEEK") (delete-system :peek :recursivep t))) (INSPECT (delete-system :inspector)) (:INSPECTOR (when (unload-file "SYS:DEBUG-TOOLS;INSPECT" :keep-symbols (cons 'tv:function-spec-p *keep-symbols*)) (update-system-keys :inspector) (update-system-menu :inspector))) (:FLAVOR-INSPECTOR (when (unload-file "SYS:DEBUG-TOOLS;FLAVOR-INSPECTOR") (update-system-menu :FLAVOR-INSPECTOR))) (:STEPPER (unload-file "SYS:DEBUG-TOOLS;STEP")) (:WINDOW-DEBUGGER (unload-file "SYS:DEBUG-TOOLS;WINDOW-DEBUG")) (W:LISP-LISTENER (when (unload-file (get-source-file-name 'W:LISP-LISTENER 'DEFFLAVOR)) (delete-system 'W:LISP-LISTENER :recursivep))) ;; Other aliases for non-intuitive names. (:TAR (delete-system :TAR-SUPPORT)) (:BUSNET (delete-system :BN)) (DELETE-SYSTEM ; can't UNLOAD-FILE here because it would break itself. (when (ask-unless-batch "Undefine functions DELETE-SYSTEM, UN-MAKE-SYSTEM, UNDEFSYSTEM, UNLOAD-FILE, and UNDEFINE-FUNCTION?") (when (get-source-file-name 'delete-system 'defun) (mark-not-loaded (get-source-file-name 'delete-system 'defun))) (MAPC #'FMAKUNBOUND '( delete-system deletable-names un-make-system remove-feature debug-print unload-file undefine-function function-spec-remprop delete-documentation delete-source-file-name function-source-file check-processes undefsystem component-system-p deletable-system-p update-system-keys update-system-menu run-cleanup-initializations update-initializations mark-not-loaded selectable-system-p same-system-p )) (makunbound '*system-deletion-table*) ;; Don't delete *packages-to-be-cleaned* because TREE-SHAKE uses and ;; clears it. t)) ) "A-list of names and and how to delete.") ))