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

;;;FILE-MATCHER.LISP

;;;FILE-MATCHER makes a closure that will be a function acceptable to
;;;tape functions as a file matcher.  This function will let the user of
;;;the tape function (e.g. RESTORE-FILES) specify once only for each
;;;top-level directory encountered whether the file "matches" and should
;;;be processed.
;;;
;;;Keyword options provide more control, over the timeout in seconds,
;;;the default answer per directory (whether it "matches"), and
;;;verbosity mode.

(defvar *file-matcher-list* nil)
(defvar *file-matcher-default* nil)
(defvar *file-matcher-timeout* (* 15 60.))
(defvar *file-matcher-verbose* nil)

(defun matcher (flist)
  (let* ((file (first flist))
	 (dir (pathname-directory file))
	 (top (string (if (atom dir) dir (first dir)))))
    (if
      (rest
	(or (find top *file-matcher-list*
		  :key #'first
		  :test #'string-equal)
	    (first
	      (push (cons top
			  (y-or-n-p-with-timeout (* *file-matcher-timeout* 60.)
						 *file-matcher-default*
						 "Process ~a directory?" top))
		    *file-matcher-list*))))
      file
      ;;else
      (if *file-matcher-verbose*
	  (format t "~&Skipping ~a" file)))))

(defun file-matcher(&key
		    (matches nil)
		    (default *file-matcher-default*)
		    (timeout *file-matcher-timeout*)
		    (verbose *file-matcher-verbose*))
  "Returns a function that will maintain a list of top-level directories
and a status indication of whether they should be processed or not. 
\
This function is suitable for use as a file-matching function within the
tape software (a match function that can be used as the value for a
:MATCH keyword).  The file matcher function accepts one argument, which
must be a (disembodied) tape file property list, where the CAR of the
list is the pathname.  The file matcher does not inspect the CDR of the
tape file property list.
\
A typical use is with TAPE:RESTORE-FILES, in cases where you want to
restore selected top level directories.  As each top level directory is
encountered, the file matcher function asks the user whether it should
be processed.  On subsequent calls, when passed a top level directory
that was previously encountered, the matcher will not ask, but will
return non-NIL on files that should be processed."
  (let((*file-matcher-list* matches)
       (*file-matcher-default* default)
       (*file-matcher-timeout* timeout)
       (*file-matcher-verbose* verbose))
    (closure '(*file-matcher-list*
		*file-matcher-default*
		*file-matcher-timeout*
		*file-matcher-verbose*)
	     'matcher)))

#|

(defun test()
  (let((fcn (file-matcher))
       (fls '("joe;a" "joe;b" "joe;c"
	      "keith;foo" "keith;stuff" "keith;more"
	      "zozz;zozzle" "zozz.zizz;zozzle"
	      "keith;morestuff")))
    (dolist (file fls)
      (setq file (fs:parse-pathname file si:local-host))
      (format t "~%File ~s - ~:[skip it~;process it~]"
	      file
	      (funcall fcn (ncons file))))))

|#