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

(DEFUN PROCESS-DIRECTORY (DIR &OPTIONAL &REST OPTIONS
			  &KEY SELECTIVE (RECURSIVE T) FILTER ONLY-LATEST (SINCE 0) (FUNCTION #'IDENTITY)
			  &ALLOW-OTHER-KEYS
			  &AUX WHOLE-DIR-LIST FILE)
  "A utility for processing directories.
Options:
 :SELECTIVE     One of NIL (default) or T. If not NIL, asks whether to copy each element.
 :RECURSIVE     One of NIL, T (default), or :WILD meaning to use wild name, type, and version.
 :FILTER        One of NIL (default) or a function to be called with the directory
                  element as its single argument.  If value returned by function is 
                  non-NIL, the element is copied.
 :ONLY-LATEST   One of NIL (default) or T. If not NIL, force :NEWEST from the source directory.
 :SINCE date    Copy only files created after date, a string or Universal Time (an integer).
 :FUNCTION      The function to be called for each file.  The argument list should look like:
                  (file &rest options &key directory-list latest &allow-other-keys)"
  (SETQ DIR (FS:PARSE-PATHNAME DIR))
  (SETQ DIR (SEND DIR :NEW-PATHNAME
		  :NAME (IF (MEMQ (SEND DIR :NAME) '(NIL :UNSPECIFIC))
			    :WILD
			  (SEND DIR :NAME))
		  :TYPE (IF (MEMQ (SEND DIR :TYPE) '(NIL :UNSPECIFIC))
			    :WILD
			  (SEND DIR :TYPE))
		  :VERSION (IF ONLY-LATEST :NEWEST
			     (IF (MEMQ (SEND DIR :VERSION) '(NIL :UNSPECIFIC))
				 :WILD
			       (SEND DIR :VERSION)))))
  (UNLESS (NUMBERP SINCE) (SETQ SINCE (TIME:PARSE-UNIVERSAL-TIME SINCE)))
  (SETQ WHOLE-DIR-LIST (FS:DIRECTORY-LIST DIR))
  (DOLIST (F WHOLE-DIR-LIST)
    (AND (SETQ FILE (CAR F))
	 (NOT (GET F :LINK-TO))
	 (OR (NOT SELECTIVE) (Y-OR-N-P "Process ~A ?" FILE))
	 (IF (get f :directory)
	     (WHEN recursive
	       (let* ((d (send file :directory))
		      (SUBDIRECTORY (cond ((CLI:LISTP D)
					   (APPEND D (NCONS (SEND file :NAME))))
					  ((eq d ':root)
					   (send file :name))
					  (t (LIST D (send file :NAME))))))
		 (APPLY 'process-directory
			(IF (EQ RECURSIVE :WILD)
			    (SEND file :new-pathname
				  :directory SUBDIRECTORY :name :wild :type :wild
				  :version (SEND DIR :VERSION))
			  (SEND DIR :NEW-DIRECTORY SUBDIRECTORY))
			options)))
	   (WHEN (AND (> (GET F :CREATION-DATE) SINCE)
		      (OR (NULL FILTER) (FUNCALL FILTER F)))
	     (APPLY FUNCTION FILE :DIRECTORY-LIST (CDR F)
				  :latest (or only-latest (determine-if-latest file whole-dir-list))
				  OPTIONS))))))

(defun determine-if-latest (f whole-dir-list)
  (let ((name (send f :name))
	(type (send f :type))
	(version (send f :version))
	(directory (send f :directory)))
    (dolist (elt whole-dir-list t)
      (let ((x (car elt)))
	(and x
	     (neq x f)
	     (equal directory (send x :directory))
	     (equal name (send x :name))
	     (equal type (send x :type))
	     (> (send x :version) version)
	     (return nil))))))

(defun sample-function (file &rest options &key directory-list latest &allow-other-keys)
  (format t "~&~S~@[ not~] latest" file (not latest)))