~ chicken-core (chicken-5) 15da5479a2dfd74a4c9e2fba011e1b9c0764a491
commit 15da5479a2dfd74a4c9e2fba011e1b9c0764a491
Author: felix <felix@call-with-current-continuation.org>
AuthorDate: Mon Jul 5 14:35:48 2010 +0200
Commit: felix <felix@call-with-current-continuation.org>
CommitDate: Mon Jul 5 14:35:48 2010 +0200
changed argument signature of find-files to use keywords (the old signature is still supported but deprecated
diff --git a/manual/Unit posix b/manual/Unit posix
index 74b8c9be..63fb5add 100644
--- a/manual/Unit posix
+++ b/manual/Unit posix
@@ -1085,34 +1085,43 @@ These variables contain error codes as returned by {{errno}}.
==== find-files
-<procedure>(find-files DIRECTORY [PREDICATE [ACTION [IDENTITY [LIMIT]]]])</procedure>
+<procedure>(find-files DIRECTORY #!key test action seed limit dotfiles follow-symlinks)</procedure>
Recursively traverses the contents of {{DIRECTORY}} (which should be a
-string) and invokes the procedure {{ACTION}} for all files in which
-the procedure {{PREDICATE}} is true. {{PREDICATE}} may be a procedure
-of one argument or a regular-expression string. {{ACTION}} should be
-a procedure of two arguments: the currently encountered file and the
-result of the previous invocation of {{ACTION}}, or, if this is the
-first invocation, the value of {{IDENTITY}}. {{PREDICATE}} defaults to
-{{(constantly #t)}}, {{ACTION}} defaults to
-{{cons}}, {{IDENTITY}} defaults to {{()}}. {{LIMIT}} should be a
-procedure of one argument that is called for each nested directory and
-which should return true, if that directory is to be traversed
-recursively. {{LIMIT}} may also be an exact integer that gives the
-maximum recursion depth. For example, a depth of {{0}} means that only
-files in the top-level, specified directory are to be traversed. In
-this case, all nested directories are ignored. {{LIMIT}} may also be
-{{#f}} (the default), which is equivalent to {{(constantly #t)}}.
-
-Note that {{ACTION}} is called with the full pathname of each file,
+string) and invokes the procedure {{action}} for all files in which
+the procedure {{test}} is true. {{test}} may be a procedure of one
+argument or a regular-expression string that will be matched with a
+full pathname using {{string-match}}. {{action}} should be a
+procedure of two arguments: the currently encountered file and the
+result of the previous invocation of {{action}}, or, if this is the
+first invocation, the value of {{seed}}. {{test}} defaults to
+{{(constantly #t)}}, {{action}} defaults to {{cons}}, {{seed}}
+defaults to {{()}}. {{limit}} should be a procedure of one argument
+that is called for each nested directory and which should return true,
+if that directory is to be traversed recursively. {{limit}} may also
+be an exact integer that gives the maximum recursion depth. For
+example, a depth of {{0}} means that only files in the top-level,
+specified directory are to be traversed. In this case, all nested
+directories are ignored. {{limit}} may also be {{#f}} (the default),
+which is equivalent to {{(constantly #t)}}.
+
+If {{dotfiles}} is given and true, then files starting with a "{{.}}"
+character will not be ignored (but note that "{{.}}" and "{{..}}" are
+always ignored). if {{follow-symlinks}} is given and true, then the
+traversal of a symbolic link that points to a directory will
+recursively traverse the latter. By default, symbolic links are not
+followed.
+
+Note that {{action}} is called with the full pathname of each file,
including the directory prefix.
-Also note that {{find-files}} will traverse symbolic links pointing to
-directories, which may lead to symlink loops or duplication of files.
-To avoid traversing symlinks, you can pass something like this as the
-{{LIMIT}} procedure:
+In older CHICKEN versions, {{find-files}} has a different argument
+signature:
- (lambda (x) (not (symbolic-link? x)))
+ (find-files DIRECTORY [TEST [ACTION [SEED [LIMIT]]]])
+
+This signature is still supported for compatibility reasons but is
+deprecated.
=== Getting the hostname and system information
diff --git a/posix-common.scm b/posix-common.scm
index a03861c9..b415879d 100644
--- a/posix-common.scm
+++ b/posix-common.scm
@@ -25,7 +25,7 @@
(declare
- (hide ##sys#stat posix-error check-time-vector)
+ (hide ##sys#stat posix-error check-time-vector ##sys#find-files)
(foreign-declare #<<EOF
#include <signal.h>
@@ -204,7 +204,9 @@ EOF
(let ([buffer (make-string 256)]
[handle (##sys#make-pointer)]
[entry (##sys#make-pointer)] )
- (##core#inline "C_opendir" (##sys#make-c-string (##sys#expand-home-path spec) 'directory) handle)
+ (##core#inline
+ "C_opendir"
+ (##sys#make-c-string (##sys#expand-home-path spec) 'directory) handle)
(if (##sys#null-pointer? handle)
(posix-error #:file-error 'directory "cannot open directory" spec)
(let loop ()
@@ -251,18 +253,15 @@ EOF
;;; Find matching files:
-(define find-files
+(define ##sys#find-files
(let ((glob glob)
(string-match string-match)
(make-pathname make-pathname)
(pathname-file pathname-file)
+ (symbolic-link? symbolic-link?)
(directory? directory?) )
- (lambda (dir #!optional
- (pred (lambda _ #t))
- (action (lambda (x y) (cons x y))) ; we want cons inlined
- (id '())
- (limit #f) )
- (##sys#check-string dir 'find-files)
+ (lambda (dir pred action id limit follow dot loc)
+ (##sys#check-string dir loc)
(let* ((depth 0)
(lproc
(cond ((not limit) (lambda _ #t))
@@ -270,9 +269,10 @@ EOF
(else limit) ) )
(pproc
(if (or (string? pred) (regexp? pred))
- (lambda (x) (string-match pred x))
+ (let ((pred (regexp pred))) ; force compilation
+ (lambda (x) (string-match pred x)))
pred) ) )
- (let loop ((fs (glob (make-pathname dir "*")))
+ (let loop ((fs (glob (make-pathname dir (if dot "?*" "*"))))
(r id) )
(if (null? fs)
r
@@ -289,5 +289,21 @@ EOF
((pproc f) (loop rest (action f r)))
(else (loop rest r)) ) ) ) ) ) ) ) )
-
-;;; TODO: add more here...
+(define (find-files dir . args)
+ (cond ((or (null? args) (not (keyword? (car args))))
+ ;; old signature - DEPRECATED
+ (let-optionals args ((pred (lambda _ #t))
+ (action (lambda (x y) (cons x y))) ; we want `cons' inlined
+ (id '())
+ (limit #f) )
+ (##sys#find-files dir pred action id limit #t #f 'find-files)))
+ (else
+ (apply
+ (lambda (#!key (test (lambda _ #t))
+ (action (lambda (x y) (cons x y))) ; s.a.
+ (seed '())
+ (limit #f)
+ (dotfiles #f)
+ (follow-symlinks #t))
+ (##sys#find-files dir test action seed limit follow-symlinks dotfiles 'find-files))
+ args))))
Trap