;; find.scm                    -*- Scheme -*-

;; Directory walker with list of predicates

;; Created:    <Wed Jul 26 22:00:38 PDT 2000>
;; Time-stamp: <Fri Jul 28 14:23:22 PDT 2000>
;; Author:     Alex Shinn <foof@debian.org>

;;; Copyright (C) 2000 Alex Shinn

;; This program is free software; you can redistribute it and/or
;; modify it under the terms of the GNU General Public License as
;; published by the Free Software Foundation; either version 2 of the
;; License, or (at your option) any later version.

;; This program is distributed in the hope that it will be useful, but
;; WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
;; General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
;; USA

;;; Motivation

;; People have posted a bunch of functions for walking directory
;; trees, modeled more or less after the Unix `find' command.  They're
;; essentially of the form (find DIRECTORY PROC), and apply PROC to
;; each file they find in the directory tree DIRECTORY.

;; It occurs to me that it might be convenient to actually have `find'
;; accept a list of procedures: (find DIRECTORY PROC ...), and for
;; each file found, apply each PROC successively, until one returns a
;; false value. That way, you could do things like this:

;;   (find "." (glob ".deps") directory?
;;         (lambda (d)
;;             ... now do something with the .deps directory d ...))
         

;; I'm imagining `glob' to be a function that accepts a filename
;; wildcard pattern and returns a predicate that likes filenames that
;; match the wildcard.

;; Maciej Stachowiak and others have suggested, as a convention, that
;; any function which accepts a predicate as an argument, and applies
;; that predicate to filenames, should also accept a string as that
;; argument, and treat that string as a wildcard pattern.  Thus, the
;; code above would become:

;;   (find "." ".deps" directory?
;;         (lambda (d) ...))

;; Now we're starting to get friendly.


;;; BUGS

;; Probably lots, but most notably the globbing functionality is not
;; complete and find doesn't detect loops in the filesystem.


;;; Shell globbing functions

(define glob->regexp
  (lambda (glob-pat)
    (let ((regexp-pat "")
          (trans-string "")
          (length (string-length glob-pat))
          (char #\nul))
      (do ((i 0 (+ i 1)))
          ((>= i length))
        (set! char (string-ref glob-pat i))
        ;; XXXX Handle more cases, handle ~, bash's {}, etc.
        (case char
          ((#\*)
           (set! trans-string ".*"))
          ((#\?)
           (set! trans-string "."))
          ((#\.)
           (set! trans-string "\\."))
          (else
           (set! trans-string (make-string 1 char))))
        (set! regexp-pat (string-append regexp-pat trans-string)))
      ;; Anchor to whole string
      (set! regexp-pat (string-append "^" regexp-pat "$"))
      regexp-pat )))

(define glob-match
  (lambda (glob-pat string)
    (string-match (glob->regexp glob-pat) string)))


;;; File testing and utility functions (XXXX need many more)

(define directory?
  (lambda (file)
    (and (access? file F_OK)
         (equal? (stat:type (stat file)) 'directory))))

(define symlink?
  (lambda (file)
    (and (access? file F_OK)
         (equal? (stat:type (stat file)) 'symlink))))

(define find:print
  (lambda (string)
    (display (string-append string "\n"))))


;;; Finding stuff

(define find:test
  (lambda (file . args)
    (if (not (null? args))
        (let ((test (car args)))
          (cond ((null? test)
                 #t )
                ((procedure? test)
                 (and (eval (list test file))
                      (eval (append (list 'find:test file)
                                    (cdr args) ))))
                ((list? test)
                 (and (eval (append test (list file)))
                      (eval (append (list 'find:test file)
                                    (cdr args) ))))
                ((string? test)
                 (and (glob-match test file)
                      (eval (append (list 'find:test file)
                                    (cdr args) ))))
                (#t (error "Bad parameter to find: " test)) )))))

(define find
  (lambda (location . args)
    (let ((dir (cond ((string=? location "")
                      ".")
                     ((string=? location "~")
                      (getenv "HOME"))
                     (#t location))))
      (cond ((directory? dir)
             (eval (append (list 'find:test dir) args))
             (let ((port (opendir dir)))
               ;; Skip "." and ".."
               (readdir port)
               (readdir port)
               (do ((f (readdir port) (readdir port)))
                   ((equal? f the-eof-object ))
                 (eval (append (list 'find (string-append dir "/" f))
                               args )))
               (closedir port) ))
            (#t (eval (append (list 'find:test dir) args))) ))))