;;; -*- 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.
\
The keyword arguments are:
   MATCHES - an a-list of top-level directory names.  The CDR of each
             a-list entry indicates whether each file under the
             directory should be processed.  For example, given a
             MATCHES of '((KEITH . T) (TOM)), all files under the KEITH
             directory will be processed, those under TOM will not be.
             (When a new top-level directory is encountered, the user is
             queried whether to process it, and the file-matching
             function *destructively* updates the MATCHES alist.
   DEFAULT - T or NIL; indicates whether a new top-level directory
             should be processed if the user query times out.
   TIMEOUT - time (in seconds) to wait for the user to respond to a
             query before taking a default action.
   VERBOSE - if non-NIL, extra-verbose messages may print out.
\
A typical use for FILE-MATCHER 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))))))

|#