;;; -*- Mode:LISP; Package:USER; Readtable:ZL; Base:10 -*-

(defun always (args) (print args) t)

(defvar *choose-file-within-module* :unbound)

(si:define-make-system-special-variable *choose-file-within-module* nil nil)

(defun choose-file-within-module (pathname binary &optional ignore)
  (setq pathname (pathname pathname))
  (if *choose-file-within-module*
      (and
	(or binary
	    (setq pathname (send pathname :source-pathname)))
	(typecase *choose-file-within-module*
	  (pathname (eq pathname *choose-file-within-module*))
	  (list (member pathname *choose-file-within-module*))
	  (t (if (eq *choose-file-within-module* t) t))))

    (and 
      (case (fquery '(
		      :type :tyi
		      :choices (((:only "Yes [select exclusively]") #/Y #/T #/SPACE #/HAND-UP)
				((:also "Also [select inclusively]") #/A #/+ #/hand-right #/hand-left)
				((:no "No [do not select]") #/N #/RUBOUT #/HAND-DOWN)))
		    "Select ~A ? " pathname)
	(:only (setq *choose-file-within-module* pathname))
	(:no nil)
	(:also
	 (if (atom *choose-file-within-module*)
	     (setq *choose-file-within-module* (list *choose-file-within-module*)))
	 (pushnew pathname *choose-file-within-module*)))
      (si:file-newer-than-file-p pathname binary))))

(defsystem kmc2
  (:name "KMC-SYSTEM")
  (:short-name "KmC")
  (:pathname-default "dj:keith;")
  (:module defs "kmc-defs")
  (:module stuff "kmc-read")
  (:module maybes ("kmctest1" "kmctest2"))
  (:compile-load defs)
  (:readfile stuff nil always)
  (:compile-load maybes nil (:fasload defs) choose-file-within-module choose-file-within-module))