This is the mail archive of the guile@cygnus.com mailing list for the guile project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Jim Blandy <jimb@red-bean.com> writes: > *choke* I am utterly destroyed... > > [Greg sent the script below to me in personal E-mail, I suspect to > avoid embarassing me. But that's not necessary. :) ] > > > For comparison (performance testing, perhaps?), this was my (very very) > > quick hack to do the same thing a couple of week ago. It uses Zsh and > > Perl (I'm sure it'd be faster if I just used one perl script, but, like > > I said, I was interested in a mostly one-shot script). I'm a little > > surprised that things were so long in the guile version--- perhaps some > > of the wildcard matching functionality of Zsh would be nice to port to > > guile. How would the guile version have looked if the following procedures where available in some library? BTW, I agree that stuff like this should exist somewhere in the guile tree. -russ (define (find-files dir . arg-ls) "Return a list of files within directory DIR. Two optional arguements are supported, PREDICATE and RECURSE?. PREDICATE should be a procedure of one argument that determines whether a particular file should be included in the returned list. As a special case, if PREDICATE is a string, it is compiled into a regular expression, and a predicate is generated that applies this regular expression to the filename. RECURSE? determines whether the procedure descends into subdirectories, and it defaults to #t. Symbolic links are not followed." (let* ((n-args (length arg-ls)) (pred (cond ((= n-args 0) (lambda (file) #t)) ((procedure? (list-ref arg-ls 0)) (list-ref arg-ls 0)) ((string? (list-ref arg-ls 0)) (let ((rx (make-regexp (list-ref arg-ls 0)))) (lambda (file) (regexp-exec rx file)))) (#t (error "bad predicate" (list-ref arg-ls 0))))) (recurse? (if (>= n-args 2) (list-ref arg-ls 1) #t))) (define (do-file file basename ret-ls) (let* ((v (lstat file))) (cond ((string=? basename ".") ret-ls) ((string=? basename "..") ret-ls) ((and (eq? (stat:type v) 'directory) recurse?) (do-dir file ret-ls)) ((pred file) (cons file ret-ls)) (#t ret-ls)))) (define (do-dir dir-name ret-ls) (let ((dir (opendir dir-name))) (do ((file (readdir dir) (readdir dir))) ((eof-object? file) ret-ls) (set! ret-ls (do-file (string dir-name "/" file) file ret-ls))) (closedir dir) ret-ls)) (do-dir dir '()))) (define (file-for-each-with-backup proc backup-suffix file-ls . error-handler) "Call PROC once for each file in FILE-LS. Before calling PROC, make a copy of the file using BACKUP-SUFFIX to generate a backup file name. ERROR-HANDLER is a optional argument that should be an error handler procedure that captures errors during the processing of a single file in FILE-LS." (let ((error-handler (and (not (null? error-handler)) (car error-handler)))) (define (do-one-file file) (copy-file file (string-append file "." backup-suffix)) (proc file)) (define (loop file-ls) (cond ((null? file-ls) #t) (error-handler (catch 'system-error (lambda () (do-one-file (car file-ls))) error-handler) (loop (cdr file-ls))) (#t (do-one-file (car file-ls)) (loop (cdr file-ls))))) (loop file-ls))) -- Why be difficult when, with a bit of effort, you could be impossible?