;;; -*- 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))))

))
