;;; -*- Mode:Lisp; Readtable:ZL; Package:USER; Base:8; Patch-File:T -*- ;;; Patch file for System version 126.141 ;;; Reason: ;;; Define a MAKE-SYSTEM condition function, SI:CHOOSE-FILE-WITHIN-SYSTEM, which allows ;;; user to select among a set of files for compile and/or load. For an example, see ;;; the definition fragment below. The user will get a chance, when compile or load ;;; conditions are run (not when :RECOMPILE or :RELOAD is used!) to select among FILE1 or FILE2. ;;; ;;; : ;;; (:module foos ("file1" "file2")) ;;; (:compile-load foos nil nil SI:CHOOSE-FILE-WITHIN-SYSTEM SI:CHOOSE-FILE-WITHIN-SYSTEM)) ;;; : ;;; Written 4-Nov-88 19:19:32 by keith (Keith Corbett) at site Gigamos Cambridge ;;; while running on Johannes Brahms from band 1 ;;; with Experimental System 126.138, Experimental ZWEI 126.28, Experimental ZMail 74.14, Experimental Local-File 76.0, Experimental File-Server 25.0, Experimental Lambda-Diag 18.0, Experimental Unix-Interface 15.0, Experimental Tape 26.4, Microcode 1762, SDU Boot Tape 3.14, SDU ROM 103, 10/17. ; From modified file DJ: L.SYS2; MAKSYS.LISP#221 at 4-Nov-88 19:19:33 #8R SYSTEM-INTERNALS#: (COMPILER-LET ((*PACKAGE* (PKG-FIND-PACKAGE "SYSTEM-INTERNALS"))) (COMPILER::PATCH-SOURCE-FILE "SYS: SYS2; MAKSYS  " ;;;A mechanism for choosing among a list of files. Use as a compile and/or load condition. (define-make-system-special-variable *choose-file-within-system* nil) (defun choose-file-within-system (pathname binary &optional ignore) (setq pathname (pathname pathname)) (if *choose-file-within-system* (and (or binary (setq pathname (send pathname :source-pathname))) (typecase *choose-file-within-system* (pathname (eq pathname *choose-file-within-system*)) (list (member pathname *choose-file-within-system*)) (t (if (eq *choose-file-within-system* t) t)))) (and (case (fquery '( :type :tyi :choices (((:only "Yes [select]") #/Y #/T #/SPACE #/HAND-UP) ((:no "No [don't select]") #/N #/RUBOUT #/HAND-DOWN) ;;;Broken: ((:include "Include this [among others]") #/I #/+)) ((:all "Proceed [include all]") #/P #/A))) "Select ~A ? " pathname) (:only (setq *choose-file-within-system* pathname)) (:no nil) (:include (if (atom *choose-file-within-system*) (setq *choose-file-within-system* (list *choose-file-within-system*))) (pushnew pathname *choose-file-within-system*)) (:all (setq *choose-file-within-system* t))) (file-newer-than-file-p pathname binary)))) ))