;--------------------------------------------------------------------------
; mapdir.kl
;
; Apply function to files in directory.
;--------------------------------------------------------------------------

;;AUTOLOAD: mapdir
;;AUTODOC: mapdir "apply a function to files in a directory"
;; (mapdir root function [:including i] [:excluding e] [:recurse r]
;;     [:dirfct l])
;; 
;; mapdir sweeps (recursevely if r is true) through the directory hierarchy
;; starting at root. Each file matching one of the wildcard in i, and not 
;; matching any wildcard in e is provided as an argument to the given
;; function.
;; if a directory is encountered, apply the lambda l to the dir name

(defun match-one (res str)
  (catch 'MATCH
    (dolist (re res)
      (and (match re str) (throw 'MATCH re)))) )

(defun mapdir-aux (path files fct recurse including excluding dirfct)
  (map ()
    (lambda (filename)
      (with (f (+ path "/" filename))
	(if (= (file-type f) 'directory)
	  (progn
	    (if recurse 
	      (mapdir-aux 
		f 
		(directory f) 
		fct 
		recurse including excluding))
	    (if dirfct (apply dirfct (list f)))
	  )
	  (and (match-one including filename)
	    (not (match-one excluding filename))
	    (fct f)))))
    files) )

(defun mapdir (root fct &key recurse including excluding dirfct)
  (if including
    (setq including (map List wildcard-to-regexp including))
    (setq including '("^.*$")))
  (if excluding
    (setq excluding (map List wildcard-to-regexp excluding))
    (setq excluding ()))
  (mapdir-aux root (directory root) fct recurse including excluding dirfct))

 
